/***************************************************************
  
        bwb_cnd.c       Conditional Expressions and Commands
                        for Bywater BASIC Interpreter
  
                        Copyright (c) 1993, Ted A. Campbell
                        Bywater Software
  
                        email: tcamp@delphi.com
  
        Copyright and Permissions Information:
  
        All U.S. and international rights are claimed by the author,
        Ted A. Campbell.
  
   This software is released under the terms of the GNU General
   Public License (GPL), which is distributed with this software
   in the file "COPYING".  The GPL specifies the terms under
   which users may copy and use the software in this distribution.
  
   A separate license is available for commercial distribution,
   for information on which you should contact the author.
  
***************************************************************/

/*---------------------------------------------------------------*/
/* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */
/* 11/1995 (eidetics@cerf.net).                                  */
/*                                                               */
/* Those additionally marked with "DD" were at the suggestion of */
/* Dale DePriest (daled@cadence.com).                            */
/*                                                               */
/* Version 3.00 by Howard Wulf, AF5NE                            */
/*                                                               */
/* Version 3.10 by Howard Wulf, AF5NE                            */
/*                                                               */
/*---------------------------------------------------------------*/



#include "bwbasic.h"

/* 
--------------------------------------------------------------------------------------------
                                STATIC UTILITY DECLARATIONS
--------------------------------------------------------------------------------------------
*/

static int FindTopLineOnStack(LineType * l);
static LineType * bwb__if_file(LineType * l, int ThenValue );
static LineType * bwb_then_else(LineType * l, int Value);
static int IsTypeMismatch( char L, char R );
static int for_limit_check( BasicNumberType Value, BasicNumberType Target, BasicNumberType Step );


/* 
--------------------------------------------------------------------------------------------
                               EXIT
--------------------------------------------------------------------------------------------
*/

LineType *
bwb_EXIT(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);
   WARN_SYNTAX_ERROR;
   return bwb_zline(l);
}

/* 
--------------------------------------------------------------------------------------------
                               SELECT
--------------------------------------------------------------------------------------------
*/
LineType *
bwb_SELECT(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);
   WARN_SYNTAX_ERROR;
   return bwb_zline(l);
}


/* 
--------------------------------------------------------------------------------------------
                               FUNCTION - END FUNCTION
--------------------------------------------------------------------------------------------
*/

/***************************************************************
  
        FUNCTION:       bwb_FUNCTION()
  
   DESCRIPTION:    This function implements the BASIC
         FUNCTION command, introducing a named
         function.
  
   SYNTAX: FUNCTION subroutine-name
              ...
              [ EXIT FUNCTION ]
              ...
           END FUNCTION
  
***************************************************************/

LineType *
bwb_FUNCTION(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);

   /* check current exec level */
   if (My->stack_head->next == NULL)
   {
      /* skip over the entire function definition */
      l = l->OtherLine; /* line of END SUB */
      l = l->next; /* line after END SUB */
      l->position = 0;
      return l;
   }

   /* we are being executed via fnc_deffn() */

   /* if this is the first time at this SUB statement, note it */
   if (My->stack_head->LoopTopLine != l)
   {
      if( bwb_incexec() )
      {
         /* OK */
         My->stack_head->LoopTopLine = l;
      }
      else
      {
         /* ERROR */
         WARN_OUT_OF_MEMORY;
         return &My->bwb_end;
      }
   }
   line_skip_eol(l);
   return bwb_zline(l);
}


LineType *
bwb_EXIT_FUNCTION(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);
   /* check integrity of SUB commmand */
   if( FindTopLineOnStack(l->OtherLine) )
   {
      /* FOUND */
      LineType *r;
      bwb_decexec();
      r = l->OtherLine; /* line of FUNCTION */
      r = r->OtherLine; /* line of END FUNCTION */
      r = r->next; /* line after END FUNCTION */
      r->position = 0;
      return r;
   }
   /* NOT FOUND */
   WARN_EXIT_FUNCTION_WITHOUT_FUNCTION;
   return bwb_zline(l);
}

LineType *
bwb_END_FUNCTION(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);

   /* check integrity of SUB commmand */
   if (FindTopLineOnStack(l->OtherLine) == FALSE)
   {
      /* NOT FOUND */
      WARN_END_FUNCTION_WITHOUT_FUNCTION;
      return bwb_zline(l);
   }
   /* decrement the stack */
   bwb_decexec();

   /* and return next from old line */
   My->stack_head->line->next->position = 0;
   return My->stack_head->line->next;
}

LineType *
bwb_FNEND(LineType * l)
{
   return bwb_END_FUNCTION( l );
}

LineType *
bwb_FEND(LineType * l)
{
   return bwb_END_FUNCTION( l );
}


/* 
--------------------------------------------------------------------------------------------
                               SUB - END SUB
--------------------------------------------------------------------------------------------
*/

/***************************************************************
  
        FUNCTION:       bwb_sub()
  
   DESCRIPTION:    This function implements the BASIC
         SUB command, introducing a named
         subroutine.
  
   SYNTAX: SUB subroutine-name
              ...
              [ EXIT SUB ]
              ...
           END SUB
  
***************************************************************/

LineType *
bwb_SUB(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);

   /* check current exec level */
   if (My->stack_head->next == NULL)
   {
      /* skip over the entire function definition */
      l = l->OtherLine; /* line of END SUB */
      l = l->next; /* line after END SUB */
      l->position = 0;
      return l;
   }
   /* we are being executed via fnc_deffn() */

   /* if this is the first time at this SUB statement, note it */
   if (My->stack_head->LoopTopLine != l)
   {
      if( bwb_incexec() )
      {
         /* OK */
         My->stack_head->LoopTopLine = l;
      }
      else
      {
         /* ERROR */
         WARN_OUT_OF_MEMORY;
         return &My->bwb_end;
      }
   }
   line_skip_eol(l);
   return bwb_zline(l);
}

LineType *
bwb_EXIT_SUB(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);
   /* check integrity of SUB commmand */
   if( FindTopLineOnStack(l->OtherLine) )
   {
      /* FOUND */
      LineType *r;
      bwb_decexec();
      r = l->OtherLine; /* line of FUNCTION */
      r = r->OtherLine; /* line of END FUNCTION */
      r = r->next; /* line after END FUNCTION */
      r->position = 0;
      return r;
   }
   /* NOT FOUND */
   WARN_EXIT_SUB_WITHOUT_SUB;
   return bwb_zline(l);
}

LineType *
bwb_END_SUB(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);

   /* check integrity of SUB commmand */
   if (FindTopLineOnStack(l->OtherLine) == FALSE)
   {
      /* NOT FOUND */
      WARN_END_SUB_WITHOUT_SUB;
      return bwb_zline(l);
   }
   /* decrement the stack */
   bwb_decexec();

   /* and return next from old line */
   My->stack_head->line->next->position = 0;
   return My->stack_head->line->next;
}

LineType *
bwb_SUBEND(LineType * l)
{
   return bwb_END_SUB( l );
}


/* 
--------------------------------------------------------------------------------------------
                                IF - END IF
--------------------------------------------------------------------------------------------
*/


/***************************************************************
  
        FUNCTION:       bwb_IF()
  
        DESCRIPTION:    This function handles the BASIC IF
                        statement, standard flavor.
  standard
      SYNTAX:     IF expression  THEN line [ELSE line]
                  IF END  # file THEN line [ELSE line]
                  IF MORE # file THEN line [ELSE line]
  
***************************************************************/
LineType *
bwb_IF(LineType * l)
{
   /* classic IF */
   /* IF expression THEN 100          */
   /* IF expression THEN 100 ELSE 200 */
   int             Value;

   bwx_DEBUG(__FUNCTION__);


   if( line_read_integer_expression(l, &Value) == FALSE )
   {
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }
   return bwb_then_else(l, Value);
}

LineType *
bwb_IF_END(LineType * l)
{
   /* IF END #1 THEN 100          */
   if( My->CurrentVersion->OptionVersionBitmask & ( C77 ) )
   {
      /* sets a linenumber to branch to on EOF */
      int  FileNumber = 0;
      int  LineNumber = 0;


      if( line_read_integer_expression( l, &FileNumber ) == FALSE )
      {
         WARN_BAD_FILE_NUMBER;
         return bwb_zline(l);
      }
      if( FileNumber <= 0 )
      {
         WARN_BAD_FILE_NUMBER;
         return bwb_zline(l);
      }
      if( line_skip_word( l, "THEN") == FALSE )
      {
         WARN_SYNTAX_ERROR;
         return bwb_zline(l);
      }
      if( line_read_integer_expression( l, &LineNumber ) == FALSE )
      {
         WARN_UNDEFINED_LINE;
         return bwb_zline(l);
      }
      if( LineNumber < 0 )
      {
         WARN_UNDEFINED_LINE;
         return bwb_zline(l);
      }
      /* now, we are ready to create the file */      
      My->CurrentFile = find_file_by_number( FileNumber );
      if( My->CurrentFile == NULL )
      {
         My->CurrentFile = file_new();
         My->CurrentFile->FileNumber = FileNumber;
      }
      My->CurrentFile->EOF_LineNumber = LineNumber;
      return bwb_zline(l);
   }   
   return bwb__if_file( l, TRUE );
}

LineType *
bwb_IF_MORE(LineType * l)
{
   /* IF MORE #1 THEN 100          */
   return bwb__if_file( l, FALSE );
}





/***************************************************************
  
        FUNCTION:       bwb_IF_THEN()
  
        DESCRIPTION:    This function handles the BASIC IF
                        statement, structured flavor.
  
      SYNTAX:     IF expression THEN
                     ...
                  ELSEIF expression
                     ...
                  ELSE
                     ...
                  END IF
  
***************************************************************/
LineType *
bwb_IF_THEN(LineType * l)
{
   /* structured IF */
   LineType *else_line;
   int             Value;

   bwx_DEBUG(__FUNCTION__);
   
   /* evaluate the expression */
   if( line_read_integer_expression(l, &Value) == FALSE )
   {
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }
   if (Value)
   {
      /* expression is TRUE */
      l->next->position = 0;
      return l->next;
   }

   /* 
   RESUME knows we iterate thru the various ELSEIF commands, and restarts at the IF THEN command.
   RESUME NEXT knows we iterate thru the various ELSEIF commands, and restarts at the END IF command.
   */

   for( else_line = l->OtherLine; else_line->cmdnum == C_ELSEIF; else_line = else_line->OtherLine )
   {
      else_line->position = else_line->Startpos;

      /* evaluate the expression */
      if( line_read_integer_expression(else_line, &Value) == FALSE )
      {
         WARN_SYNTAX_ERROR;
         return bwb_zline(l);
      }
      if (Value)
      {
         /* expression is TRUE */
         else_line->next->position = 0;
         return else_line->next;
      }
   }
   /* ELSE or END IF */
   else_line->next->position = 0;
   return else_line->next;   
}

LineType *
bwb_ELSEIF(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);

   for( l = l->OtherLine; l->OtherLine != NULL; l = l->OtherLine );
   l = l->next; /* line after END IF */
   l->position = 0;
   return l; 
}

LineType *
bwb_ELSE(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);
   
   for( l = l->OtherLine; l->OtherLine != NULL; l = l->OtherLine );
   l = l->next; /* line after END IF */
   l->position = 0;
   return l; 
}

LineType *
bwb_END_IF(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);
   return bwb_zline(l);
}

/* 
--------------------------------------------------------------------------------------------
                                 SELECT CASE - END SELECT
--------------------------------------------------------------------------------------------
*/


/***************************************************************
  
        FUNCTION:       bwb_select()
  
        DESCRIPTION:    This C function handles the BASIC SELECT
                        statement.
  
   SYNTAX:     SELECT CASE expression           ' examples:
               CASE value                       ' CASE 5
               CASE min TO max                  ' CASE 1 TO 10
               CASE IF relationaloperator value ' CASE IF > 5
               CASE IS relationaloperator value ' CASE IS > 5
               CASE ELSE
               END SELECT
  
***************************************************************/



LineType *
bwb_SELECT_CASE(LineType * l)
{
   VariantType selectvalue;
   VariantType *e = &selectvalue;
   LineType *else_line;

   bwx_DEBUG(__FUNCTION__);

   /* evaluate the expression */
   if( line_read_expression( l, e ) == FALSE )
   {
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }
   /* 
   RESUME knows we iterate thru the various CASE commands, and restarts at the SELECT CASE command.
   RESUME NEXT knows we iterate thru the various CASE commands, and restarts at the END SELECT command.
   */
   for( else_line = l->OtherLine; else_line->cmdnum == C_CASE; else_line = else_line->OtherLine )
   {
      else_line->position = else_line->Startpos;
      do
      {
         /* evaluate the expression */
         if( line_skip_word( else_line, "IF" ) || line_skip_word( else_line, "IS" ) )
         {
            /* CASE IS < 10    */
            /* CASE IF < "DEF" */
            /* CASE IS > 7     */
            /* CASE IS > "ABC" */
         
            char            tbuf[BasicStringLengthMax + 1];
            int             position;
            VariantType casevalue;
            VariantType *r = &casevalue;

            if( e->TypeChar == BasicStringSuffix )
            {
               /* STRING */
               bwb_strcpy( tbuf, e->Buffer );
            }
            else
            {
               /* NUMBER */
               sprintf(tbuf, BasicNumberPrintFormat, e->Number );
            }
            bwb_strcat( tbuf, " " );
            bwb_strcat( tbuf, &(else_line->buffer[else_line->position]));
            position = 0;
            if( buff_read_expression( tbuf, &position, r) == FALSE )
            {
               WARN_SYNTAX_ERROR;
               return bwb_zline(l);
            }
            if( r->TypeChar == BasicStringSuffix )
            {
               RELEASE( r );
               WARN_TYPE_MISMATCH;
               return bwb_zline(l);
            }
            if (r->Number)
            {
               /* expression is TRUE */
               else_line->next->position = 0;
               return else_line->next;
            }
            /* condition is FALSE */
            /* proceed to next CASE line if there is one */
         }
         else
         {
            /* CASE 7 */
            /* CASE 7 TO 10 */
            /* CASE "ABC" */
            /* CASE "ABC" TO "DEF" */
            VariantType minvalue;
            VariantType * minval = &minvalue;

            /* evaluate the MIN expression */   
            if( line_read_expression( else_line, minval ) == FALSE )
            {
               WARN_SYNTAX_ERROR;
               return bwb_zline(l);
            }
            if( IsTypeMismatch(e->TypeChar, minval->TypeChar) )
            {
               RELEASE( minval );
               WARN_TYPE_MISMATCH;
               return bwb_zline(l);
            }
            if( line_skip_word( else_line, "TO" ) )
            {
               /* CASE 7 TO 10 */
               /* CASE "ABC" TO "DEF" */
               VariantType maxvalue;
               VariantType * maxval = &maxvalue;

               /* evaluate the MAX expression */
               if( line_read_expression( else_line, maxval ) == FALSE )
               {
                  WARN_SYNTAX_ERROR;
                  return bwb_zline(l);
               }
               if( IsTypeMismatch(e->TypeChar, maxval->TypeChar) )
               {
                  RELEASE( maxval );
                  WARN_TYPE_MISMATCH;
                  return bwb_zline(l);
               }
               if (e->TypeChar == BasicStringSuffix)
               {
                  /* STRING */  
                  if ( bwb_strcmp( e->Buffer, minval->Buffer ) >= 0
                  &&   bwb_strcmp( e->Buffer, maxval->Buffer ) <= 0)
                  {
                     /* expression is TRUE */
                     else_line->next->position = 0;
                     return else_line->next;
                  }
               }
               else
               {
                  /* NUMBER */
                  if( e->Number >= minval->Number
                  &&  e->Number <= maxval->Number )
                  {
                     /* expression is TRUE */
                     else_line->next->position = 0;
                     return else_line->next;
                  }
               }
            }
            else
            {
               /* CASE 7 */
               /* CASE "ABC" */
               if (e->TypeChar == BasicStringSuffix)
               {
                  /* STRING */  
                  if (bwb_strcmp( e->Buffer, minval->Buffer ) == 0)
                  {
                     /* expression is TRUE */
                     else_line->next->position = 0;
                     return else_line->next;
                  }
               }
               else
               {
                  /* NUMBER */
                  if( e->Number == minval->Number )
                  {
                     /* expression is TRUE */
                     else_line->next->position = 0;
                     return else_line->next;
                  }
               }
            }
            /* condition is FALSE */
            /* proceed to next CASE line if there is one */
         }
      }
      while( line_skip_comma( else_line ) );
   }
   /* CASE_ELSE or END_SELECT */
   else_line->next->position = 0;
   return else_line->next;   
}

LineType *
bwb_CASE(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);

   for( l = l->OtherLine; l->OtherLine != NULL; l = l->OtherLine );
   l = l->next; /* line after END SELECT */
   l->position = 0;
   return l; 
}

LineType *
bwb_CASE_ELSE(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);

   for( l = l->OtherLine; l->OtherLine != NULL; l = l->OtherLine );
   l = l->next; /* line after END SELECT */
   l->position = 0;
   return l; 
}


LineType *
bwb_END_SELECT(LineType * l)
{
   bwx_DEBUG(__FUNCTION__);
   return bwb_zline(l);
}

/* 
--------------------------------------------------------------------------------------------
                                DO - LOOP
--------------------------------------------------------------------------------------------
*/

/***************************************************************
  
   FUNCTION:       bwb_DO()
  
   DESCRIPTION:    This C function implements the ANSI BASIC
         DO statement.
  
   SYNTAX:     DO [UNTIL|WHILE condition]
                  ...
                  [EXIT DO]
                  ...
               LOOP [UNTIL|WHILE condition]
  
***************************************************************/

LineType *
bwb_DO(LineType * l)
{
   LineType *r;
   int Value;
   bwx_DEBUG(__FUNCTION__);
   /* DO ' forever */
   /* DO UNTIL ' exits when != 0 */
   /* DO WHILE ' exits when == 0 */

   do
   {
      /* evaluate the expression */
      if( line_is_eol( l ) )
      {
         break; /* exit 'do' */
      }
      else
      if( line_skip_word( l, "UNTIL" ) )
      {
         /* DO UNTIL */
         if( line_read_integer_expression(l, &Value) == FALSE )
         {
            WARN_SYNTAX_ERROR;
            return bwb_zline(l);
         }

         if (Value != 0)
         {
            /* EXIT DO */
            r = l->OtherLine; /* line of LOOP */
            r = r->next;      /* line after LOOP */
            r->position = 0;
            return r;
         }
      }
      else
      if( line_skip_word( l, "WHILE" ) )
      {
         /* DO WHILE */
         if( line_read_integer_expression(l, &Value) == FALSE )
         {
            WARN_SYNTAX_ERROR;
            return bwb_zline(l);
         }

         if (Value == 0)
         {
            /* EXIT DO */
            r = l->OtherLine; /* line of LOOP */
            r = r->next;      /* line after LOOP */
            r->position = 0;
            return r;
         }
      }
      
   }
   while( line_skip_comma( l ) );

   return bwb_zline(l);
}


LineType *
bwb_EXIT_DO(LineType * l)
{
   LineType *r;
   bwx_DEBUG(__FUNCTION__);
   /* EXIT DO */
   r = l->OtherLine; /* line of DO */
   r = r->OtherLine; /* line of LOOP */
   r = r->next;      /* line after LOOP */
   r->position = 0;
   return r;
}


LineType *
bwb_LOOP(LineType * l)
{
   LineType *r;
   int Value;
   bwx_DEBUG(__FUNCTION__);
   
   /* LOOP ' forever */
   /* LOOP UNTIL ' exits when != 0 */
   /* LOOP WHILE ' exits when == 0 */

   do
   {
      /* evaluate the expression */
      if( line_is_eol( l ) )
      {
         break; /* exit 'do' */
      }
      else
      if( line_skip_word( l, "UNTIL" ) )
      {
         /* LOOP UNTIL */
         if( line_read_integer_expression(l, &Value) == FALSE )
         {
            WARN_SYNTAX_ERROR;
            return bwb_zline(l);
         }

         if (Value != 0)
         {
            /* EXIT DO */
            return bwb_zline(l);
         }
      }
      else
      if( line_skip_word( l, "WHILE" ) )
      {
         /* LOOP WHILE */
         if( line_read_integer_expression(l, &Value) == FALSE )
         {
            WARN_SYNTAX_ERROR;
            return bwb_zline(l);
         }

         if (Value == 0)
         {
            /* EXIT DO */
            return bwb_zline(l);
         }
      }
      
   }
   while( line_skip_comma( l ) );

   /* loop around to DO again */
   r = l->OtherLine; /* line of DO */
   r->position = 0;
   return r;
}



/* 
--------------------------------------------------------------------------------------------
                                WHILE - WEND
--------------------------------------------------------------------------------------------
*/




/***************************************************************
  
        FUNCTION:       bwb_WHILE()
  
        DESCRIPTION:    This function handles the BASIC
                        WHILE statement.
  
   SYNTAX:     WHILE expression ' exits when == 0
                 ...
                 [EXIT WHILE]
                 ...
               WEND
  
  
***************************************************************/
LineType *
bwb_WHILE(LineType * l)
{
   int Value;

   LineType * r;
   bwx_DEBUG(__FUNCTION__);

   if( line_read_integer_expression(l, &Value) == FALSE )
   {
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }
   if ( Value == 0 )
   {
      /* EXIT WHILE */
      r = l->OtherLine; /* line of WEND */
      r = r->next;      /* line after WEND */
      r->position = 0;
      return r;
   }
   return bwb_zline(l);
}


LineType *
bwb_EXIT_WHILE(LineType * l)
{
   LineType *r;
   bwx_DEBUG(__FUNCTION__);
   /* EXIT WHILE */
   r = l->OtherLine; /* line of WHILE */
   r = r->OtherLine; /* line of WEND */
   r = r->next;      /* line after WEND */
   r->position = 0;
   return r;
}

LineType *
bwb_WEND(LineType * l)
{
   LineType *r;
   bwx_DEBUG(__FUNCTION__);
   r = l->OtherLine; /* line of WHILE */
   r->position = 0;
   return r;
}


/* 
--------------------------------------------------------------------------------------------
                                UNTIL - UEND
--------------------------------------------------------------------------------------------
*/







/***************************************************************
  
        FUNCTION:       bwb_UNTIL()
  
        DESCRIPTION:    This function handles the BASIC 
                         UNTIL statement.
  
   SYNTAX:     UNTIL expression ' exits when != 0
                 ...
                 [EXIT UNTIL]
                 ...
               UEND
                       
  
***************************************************************/
LineType *
bwb_UNTIL(LineType * l)
{
   int Value;

   LineType * r;
   bwx_DEBUG(__FUNCTION__);

   if( line_read_integer_expression(l, &Value) == FALSE )
   {
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }
   if ( Value != 0 )
   {
      /* EXIT UNTIL */
      r = l->OtherLine; /* line of UEND */
      r = r->next;      /* line after UEND */
      r->position = 0;
      return r;
   }
   return bwb_zline(l);
}


LineType *
bwb_EXIT_UNTIL(LineType * l)
{
   LineType *r;
   bwx_DEBUG(__FUNCTION__);
   /* EXIT UNTIL */
   r = l->OtherLine; /* line of UNTIL */
   r = r->OtherLine; /* line of UEND */
   r = r->next;      /* line after UEND */
   r->position = 0;
   return r;
}


LineType *
bwb_UEND(LineType * l)
{
   LineType *r;
   bwx_DEBUG(__FUNCTION__);
   r = l->OtherLine; /* line of UNTIL */
   r->position = 0;
   return r;
}


/* 
--------------------------------------------------------------------------------------------
                                FOR - NEXT
--------------------------------------------------------------------------------------------
*/



/***************************************************************
  
        FUNCTION:       bwb_for()
  
        DESCRIPTION:    This function handles the BASIC FOR
                        statement.
  
   SYNTAX:     FOR counter = start TO finish [STEP increment]
                 ...
                 [EXIT FOR]
                 ...
               NEXT [counter]
  
NOTE:    This is controlled by the OptionVersion bitmask.
  
    The order of expression evaluation and variable creation varies.
    For example:
        FUNCTION FNA( Y )
            PRINT "Y="; Y
            FNA = Y
        END FUNCTION
        FOR X = FNA(3) TO FNA(1) STEP FNA(2)
        NEXT X
    ANSI/ECMA;
        Y= 1
        Y= 2
        Y= 3
        X is created (if it does not exist)
        X is assigned the value of 3
    MICROSOFT;
        X is created (if it does not exist)
        Y= 3
        X is assigned the value of 3
        Y= 1
        Y= 2
  
  
ECMA-55: Section 13.4
       ...
       The action of the for-statement and the next-statement is de-
       fined in terms of other statements, as follows:
  
              FOR v = initial-value TO limit STEP increment
              (block)
              NEXT v
  
       is equivalent to:
  
              LET own1 = limit
              LET own2 = increment
              LET v = initial-value
       line1  IF (v-own1) * SGN (own2) > 0 THEN line2
              (block)
              LET v = v + own2
              GOTO line1
       line2  REM continued in sequence
       ...
  
***************************************************************/


LineType *
bwb_FOR(LineType * l)
{
   LineType *r;
   VariableType *v;
   BasicNumberType Value;
   BasicNumberType Target;
   BasicNumberType Step;
   VariantType variant;
   bwx_DEBUG(__FUNCTION__);
   

   /* if this is the first time at this FOR statement, note it */
   if (FindTopLineOnStack(l) == FALSE)
   {
      if( bwb_incexec() )
      {
         /* OK */
      }
      else
      {
         /* ERROR */
         WARN_OUT_OF_MEMORY;
         return &My->bwb_end;
      }
   }

   /* INITIALIZE */
   
   
   if( (v = line_read_scalar( l )) == NULL )
   {
      WARN_VARIABLE_NOT_DECLARED;
      return bwb_zline(l);
   }
   if( v->dimensions > 0 )
   {
      WARN_TYPE_MISMATCH;
      return bwb_zline(l);
   }
   if( v->VariableTypeChar == BasicStringSuffix )
   {
      WARN_TYPE_MISMATCH;
      return bwb_zline(l);
   }
   if( line_skip_char( l, '=' ) == FALSE )
   {
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }
   if( line_read_numeric_expression( l, &Value) == FALSE )      
   {
      WARN_ILLEGAL_FUNCTION_CALL;
      return bwb_zline(l);
   }
   if (My->CurrentVersion->OptionFlags & OPTION_BUGS_ON /* FOR X = ... */ )
   {
      /* Assign Variable */
      variant.TypeChar = v->VariableTypeChar;
      variant.Number = Value;
      if( var_set( v, &variant ) == FALSE )
      {
         WARN_VARIABLE_NOT_DECLARED;
         return bwb_zline( l );
      }
   }
   else
   {
      /* assigned below */
   }
   if( line_skip_word( l, "TO" ) == FALSE )
   {
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }
   if( line_read_numeric_expression( l, &Target) == FALSE )      
   {
      WARN_ILLEGAL_FUNCTION_CALL;
      return bwb_zline(l);
   }
   if( line_skip_word( l, "STEP" )  )
   {
      if( line_read_numeric_expression( l, &Step) == FALSE )      
      {
         WARN_ILLEGAL_FUNCTION_CALL;
         return bwb_zline(l);
      }
   }
   else
   {
      Step = 1;
   }
   if (My->CurrentVersion->OptionFlags & OPTION_BUGS_ON /* FOR X = ... */ )
   {
      /* assigned above */
   }
   else
   {
      /* Assign Variable */
      variant.TypeChar = v->VariableTypeChar;
      variant.Number = Value;
      if( var_set( v, &variant ) == FALSE )
      {
         WARN_VARIABLE_NOT_DECLARED;
         return bwb_zline( l );
      }
   }

   /* CHECK */
   if ( for_limit_check( Value, Target, Step ) )
   {
      /* EXIT FOR */
      bwb_decexec();

      r = l->OtherLine; /* line of NEXT */
      r = r->next;      /* line after NEXT */
      r->position = 0;
      return r;
   }

   /* we will loop at least once */
   My->stack_head->line = l;
   My->stack_head->code = EXEC_FOR;
   My->stack_head->local_variable = v;
   My->stack_head->for_step = Step;
   My->stack_head->for_target = Target;
   My->stack_head->LoopTopLine = l;
   My->stack_head->OnErrorGoto = 0;
   /* proceed with processing */
   return bwb_zline(l);
}


LineType *
bwb_EXIT_FOR(LineType * l)
{
   LineType *r;
   bwx_DEBUG(__FUNCTION__);

   if (FindTopLineOnStack(l->OtherLine) == FALSE)
   {
      WARN_EXIT_FOR_WITHOUT_FOR;
      return bwb_zline(l);
   }
   My->stack_head->code = EXEC_FOR;
   bwb_decexec();

   r = l->OtherLine; /* line of FOR */
   r = r->OtherLine; /* line of NEXT */
   r = r->next;      /* line after NEXT */
   r->position = 0;
   return r;
}


LineType *
bwb_NEXT(LineType * l)
{
   LineType *r;
   VariableType *v;
   BasicNumberType Value;
   BasicNumberType Target;
   BasicNumberType Step;
   bwx_DEBUG(__FUNCTION__);
   

   if (FindTopLineOnStack(l->OtherLine) == FALSE)
   {
      WARN_NEXT_WITHOUT_FOR;
      return bwb_zline(l);
   }
   My->stack_head->code = EXEC_FOR;
   
   /* INCREMENT */
   v      = My->stack_head->local_variable;
   Target = My->stack_head->for_target;
   Step   = My->stack_head->for_step;

   /* if( TRUE ) */
   {
      VariantType variant;
      if( var_get( v, &variant ) == FALSE )
      {
         WARN_NEXT_WITHOUT_FOR;
         return bwb_zline(l);
      }
      if( variant.TypeChar == '$' )
      {
         WARN_NEXT_WITHOUT_FOR;
         return bwb_zline(l);
      }
      variant.Number += Step;
      Value = variant.Number;
      if( var_set( v, &variant ) == FALSE )
      {
         WARN_NEXT_WITHOUT_FOR;
         return bwb_zline(l);
      }
   }
   
   /* CHECK */
   if ( for_limit_check( Value, Target, Step ) )
   {
      /* EXIT FOR */
      bwb_decexec();
      return bwb_zline(l);
   }
   /* proceed with processing */
   r = l->OtherLine; /* line of FOR */
#if 0 
   /* 
   This example causes a Syntax Error:
   100 FOR I = 1 TO 1000:NEXT
   The error is actually caused by execline().
   Note that the example is a delay loop.
   Only NEXT has this issue, because it jumps to TOP->next.
   All other loop structures jump to either TOP or BOTTOM->next.
   */
   r = r->next;      /* line after FOR */
   r->position = 0;
#endif
   line_skip_eol(r);
   return r;
}


/* 
--------------------------------------------------------------------------------------------
                                STATIC UTILITY ROUTINES
--------------------------------------------------------------------------------------------
*/


static int FindTopLineOnStack(LineType * l)
{
   /* since we are at the top of a loop, we MIGHT be on the stack */
   StackType * stack_item;

   bwx_DEBUG(__FUNCTION__);

   for ( stack_item = My->stack_head; stack_item != NULL; stack_item = stack_item->next )
   {
      LineType *current;

      current = stack_item->LoopTopLine;
      if (current != NULL)
      {
         if (current == l)
         {
            /* FOUND */
            while (My->stack_head != stack_item)
            {
               bwb_decexec();
            }
            /* we are now the top item on the stack */
            return TRUE;
         }
         /* do NOT cross a function/sub boundary */
         switch (current->cmdnum)
         {
         case C_FUNCTION:
         case C_SUB:
         case C_GOSUB:
            /* NOT FOUND */
            return FALSE;
            /* break; */
         }
      }
   }
   /* NOT FOUND */
   return FALSE;
}

static LineType * bwb__if_file(LineType * l, int ThenValue )
{
   /* IF END  # filenumber THEN linenumber */
   /* IF MORE # filenumber THEN linenumber */
   int             Value;
   int FileNumber;

   bwx_DEBUG(__FUNCTION__);


   if( line_skip_char(l,BasicFileNumberPrefix) )
   {
      /* IF END # */
      FileType * F;

      if( line_read_integer_expression( l, &FileNumber ) == FALSE )
      {
         WARN_BAD_FILE_NUMBER;
         return bwb_zline(l);
      }
      if( FileNumber < 0 )
      {
         /* Printer is NOT EOF */
         Value = FALSE;
      }
      else
      if( FileNumber == 0 )
      {
         /* Console is NOT EOF */
         Value = FALSE;
      }
      else
      {
         /* normal file */
         F = find_file_by_number( FileNumber );
         if( F == NULL )
         {
            WARN_BAD_FILE_NUMBER;
            return bwb_zline(l);
         }
         /* if( TRUE ) */
         {
            /* actual file -- are we at the end? */
            FILE           *fp;
            long             current;
            long             total;
            fp = F->cfp;
            current = ftell(fp);
            fseek(fp, 0, SEEK_END);
            total = ftell(fp);
            if (total == current)
            {
               /* EOF */
               Value = TRUE;
            }
            else
            {
               /* NOT EOF */
               Value = FALSE;
               fseek(fp, current, SEEK_SET);
            }
         }   
      }   
   }
   else
   {
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }
   
   if (Value == ThenValue)
   {
      /* expression is TRUE, take THEN path */
      return bwb_then_else(l, TRUE);
   }
   /* expression is FALSE, take ELSE path */
   return bwb_then_else(l, FALSE);
}

static LineType * bwb_then_else(LineType * l, int Value)
{
   /* 
   ... THEN 100 
   ... THEN 100 ELSE 200 
   
   The deciding expression has already been parsed and evaluated.
   If Value != 0, then we want to take the THEN path.
   If Value == 0, then we want to take the ELSE path.
   */

   int             LineNumber;
   LineType *x;

   if( line_skip_comma(l) )
   {
      /* OK */
   }
   else
   {
      /* OPTIONAL */
   }

   if( line_skip_word( l, "THEN" ) )
   {
      /* OK */
   }
   else
   if( line_skip_word( l, "GOTO" ) )
   {
      /* OK */
   }
   else
   {
      /* REQUIRED */
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }

   /* read THEN's LineNumber */
   if( line_read_integer_expression(l, &LineNumber) == FALSE )
   {
      WARN_SYNTAX_ERROR;
      return bwb_zline(l);
   }

   if (Value == 0)
   {
      /* expression is FALSE, take ELSE path */
      if( line_is_eol( l ) )
      {
         /* OPTIONAL */
         return bwb_zline(l);
      }
      
      if( line_skip_comma(l) )
      {
         /* OK */
      }
      else
      {
         /* OPTIONAL */
      }

      if( line_skip_word( l, "ELSE" ) )
      {
         /* OK */
      }
      else
      {
         /* REQUIRED */
         WARN_SYNTAX_ERROR;
         return bwb_zline(l);
      }

      if( line_read_integer_expression(l, &LineNumber) == FALSE )
      {
         WARN_SYNTAX_ERROR;
         return bwb_zline(l);
      }
   }

   x = NULL;
#if THE_PRICE_IS_RIGHT
   if( l->OtherLine != NULL )
   {
      /* look in the cache */   
      if( l->OtherLine->number == LineNumber )
      {
            x = l->OtherLine; /* found in cache */
      }
   }
#endif /* THE_PRICE_IS_RIGHT */
   if( x == NULL )
   {
      x = find_line_number( LineNumber, TRUE );
   }
   if (x != NULL)
   {
      line_skip_eol(l);
      x->position = 0;
#if THE_PRICE_IS_RIGHT
      l->OtherLine = x; /* save in cache */
#endif /* THE_PRICE_IS_RIGHT */
      return x;
   }
   WARN_SYNTAX_ERROR;
   return bwb_zline(l);

}

static int IsTypeMismatch( char L, char R )
{
   if( L == BasicStringSuffix && R == BasicStringSuffix )
   {
      /* both STRING */
      return FALSE;
   }
   if( L != BasicStringSuffix && R != BasicStringSuffix )
   {
      /* both NUMBER */
      return FALSE;
   }
   /* TYPE MISMATCH */
   return TRUE;
}

static int for_limit_check( BasicNumberType Value, BasicNumberType Target, BasicNumberType Step )
{
   if (Step > 0)
   {
      /* POSITIVE */
      if (Value > Target)
      {
         /* FOR I = 3 TO 2 STEP 1 */
         return TRUE;
      }
   }
   else
   {
      /* NEGATIVE */
      if (Value < Target)
      {
         /* FOR I = -3 TO -2 STEP -1 */
         return TRUE;
      }
   }
   return FALSE;
}

/* EOF */