/* l2xixstm.c  LTX2X interpreter statement executor routines    */
/*  Written by: Peter Wilson, CUA  [email protected]                */
/*  This code is partly based on algorithms presented by Ronald Mak in */
/*  "Writing Compilers & Interpreters", John Wiley & Sons, 1991        */

#include <stdio.h>
#include "l2xicmon.h"
#include "l2xierr.h"
#include "l2xiscan.h"
#include "l2xisymt.h"
#include "l2xiprse.h"
#include "l2xiidbg.h"
#include "l2xiexec.h"

/* GLOBALS */

BOOLEAN executed_return;           /* TRUE iff return statement executed */

/* EXTERNALS */

extern int level;
extern int exec_line_number;;
extern long exec_stmt_count;

extern ICT *code_segmentp;           /* code segment ptr */
extern ICT *statement_startp;        /* ptr to start of statement */
extern TOKEN_CODE ctoken;            /* token from code segment */

extern STACK_ITEM *stack;                  /* runtime stack */
extern STACK_ITEM_PTR tos;                 /* ptr to top of runtime stack */
extern STACK_ITEM_PTR stack_frame_basep;   /* ptr to stack fame base */

extern BOOLEAN stack_flag;

extern BOOLEAN is_value_undef();
extern STRING get_stacked_string();

/* MACROS */

/* is_undef(tp1)  TRUE iff type tp1 is undef */
#define is_undef(tp1) (tp1 == any_typep)


/***************************************************************************/
/* exec_statement()  Execute a statement by calling appropriate routine    */
/*      returns the token code of the statement                            */

TOKEN_CODE exec_statement()
{
 TOKEN_CODE stmt_tok;
 entry_debug("exec_statement (l2xixstm.c)");

 if (ctoken == STATEMENT_MARKER) {
   exec_line_number = get_statement_cmarker();
   ++exec_stmt_count;

   statement_startp = code_segmentp;
   trace_statement_execution();
   get_ctoken();
 }
 stmt_tok = ctoken;

 switch (ctoken) {
   case IDENTIFIER: {
     SYMTAB_NODE_PTR idp = get_symtab_cptr();

     if (idp->defn.key == PROC_DEFN ||
         idp->defn.key == FUNC_DEFN) exec_routine_call(idp);
     else exec_assignment_statement(idp);
     break;
   }
   case BEGIN: {
     exec_compound_statement();
     break;
   }
   case CASE: {
     exec_case_statement();
     break;
   }
   case IF: {
     exec_if_statement();
     break;
   }
   case REPEAT: {
     exec_grepeat_statement();
     break;
   }
   case SEMICOLON:
   case END:
   case ELSE:
   case UNTIL: {
     break;
   }
      /* extensions for EXPRESS and ltx2x */
   case XSKIP : {
     break;
   }
   case XESCAPE : {
     break;
   }
   case XRETURN : {
     exec_return_statement();
     exit_debug("exec_statement at XRETURN");
     return(stmt_tok);
   }
   case END_OF_STATEMENTS: {
     exit_debug("exec_statement at END_OF_STATEMENTS");
     return(stmt_tok);
   }
   case ENDCODE: {
     exit_debug("exec_statement at ENDCODE");
     return(stmt_tok);
   }
/*    case ENDCODE: {          added for ltx2x to stop execution */
/*      exit_debug("exec_statement");
*       return;
*      break;
*    }
*/
   default: {
     runtime_error(UNIMPLEMENTED_RUNTIME_FEATURE);
     break;
   }
 } /* end switch */

 while (ctoken == SEMICOLON) get_ctoken();

 exit_debug("exec_statement");
 return(stmt_tok);
}                                                   /* end exec_statement  */
/***************************************************************************/



/***************************************************************************/
/* exec_return_statement()    Execute a return statement                   */
/*    at entry, ctoken = RETURN                                            */
/*    at exit, ctoken is token after RETURN                                */

exec_return_statement()
{
 entry_debug("exec_return_statement");

 get_ctoken();
/*  if (ctoken == LPAREN) exec_expression(); */
 executed_return = TRUE;

 exit_debug("exec_return_statement");
 return;
}                                             /* end EXEC_RETURN_STATEMENT */
/***************************************************************************/



/***************************************************************************/
/* exec_assignment_statement(idp)  Execute an assignment statement         */
/*                                                                         */

exec_assignment_statement(idp)
SYMTAB_NODE_PTR idp;                /* target variable id */
{
 STACK_ITEM_PTR targetp;           /* ptr to assignment target */
 TYPE_STRUCT_PTR target_tp, base_target_tp, expr_tp;
 BOOLEAN data_area;

 entry_debug("exec_assignment_statement");
 data_area = FALSE;

 /* Assignment to function id: target is first item of appropriate stack frame */
 if (idp->defn.key == FUNC_DEFN) {
   STACK_ITEM_PTR hp;
   int delta;                     /* difference in levels */

   hp = (STACK_ITEM_PTR) stack_frame_basep;
   delta = level - idp->level - 1;
   while (delta-- > 0) {
     hp = (STACK_ITEM_PTR) get_static_link((ADDRESS) hp);
   }
   targetp = (STACK_ITEM_PTR) hp;
   target_tp = idp->typep;
   get_ctoken();
 }

 /* Assignment to variable: Routine exec_variable leaves target address */
 /*                         on top of stack */
 else {
   if ((idp->typep->form == ARRAY_FORM) || (idp->typep->form == ENTITY_FORM)) {
     data_area = TRUE;
     debug_print("data_area is TRUE\n");
   }
   target_tp = exec_variable(idp, TARGET_USE);
   targetp = (STACK_ITEM_PTR) get_address(tos);

   pop();         /* pop off the target address */
 }

 base_target_tp = base_type(target_tp);

 /* Routine exec-expression leaves expression value on top of stack */
 get_ctoken();
 expr_tp = exec_expression();

 if (stack_flag) {
   log_print("Assignment LHS: ");
   expression_type_debug(target_tp);
   log_print("Assignment RHS: ");
   expression_type_debug(expr_tp);
 }


 /* do the assignment */

 exec_the_assign(targetp, target_tp, expr_tp);

 trace_data_store(idp, idp->typep, targetp, target_tp);

 exit_debug("exec_assignment_statement");
 return;
}                                         /* end exec_assignment_statement */
/***************************************************************************/



/***************************************************************************/
/* exec_the_assign(targetp, target_tp, expr_tp)  Do the actual assignment  */
/*             targetp, target_tp are the target and its type;             */
/*             expr_tp is the RHS type with its value on top of the stack. */
/*     The current token is unchanged                                      */

exec_the_assign(targetp, target_tp, expr_tp)
STACK_ITEM_PTR targetp;                 /* ptr to LHS */
TYPE_STRUCT_PTR target_tp;              /* ptr to type of LHS */
TYPE_STRUCT_PTR expr_tp;                /* ptr to type of RHS */
{
 TYPE_STRUCT_PTR base_target_tp;      /* ptr to LHS base type */
 STACK_TYPE rhstype;                  /* type on top of the stack */
 int size;
 entry_debug("exec_the_assign");

 if (is_undef(expr_tp) || is_value_undef(tos)) {
   put_undef(targetp);
   pop();
   exit_debug("exec_the_assign at undef");
   return;
 }

 rhstype = get_stackval_type(tos);
 if (expr_tp->form == ARRAY_FORM) {    /* then RHS is an array (element?) */
   if (rhstype == STKADD) {
     copy_value(tos, get_address(tos));
   }
 }

 base_target_tp = base_type(target_tp);

 if ((target_tp == real_typep) && (base_type(expr_tp) == integer_typep)) {
   /* real := integer */
   put_real(targetp, (XPRSAREAL) get_integer(tos));
 }

 else if (target_tp == logical_typep) {
     /* logical := logical */
   put_logical(targetp, get_logical(tos));
 }

 else if (target_tp->form == STRING_FORM && expr_tp->form == STRING_FORM) {
      /* string := string */
    exec_string_assign((STACK_ITEM_PTR) targetp);
 }

 else if (target_tp->form == ARRAY_FORM) {
   if (base_type(expr_tp) == target_tp->info.array.elmt_typep) { /* array := el */
     copy_value(targetp, tos);
   }
   else {             /* assume array := array */
     ICT *ptr1 = (ICT *) targetp;
     ICT *ptr2 = get_address(tos);
     size = target_tp->size;
     while (size--) *ptr1++ = *ptr2++;
   }
 }

 else if (target_tp->form == ENTITY_FORM ) {
   /* entity := entity */
   ICT *ptr1 = (ICT *) targetp;
   ICT *ptr2 = get_address(tos);
   size = target_tp->size;
   while (size--) *ptr1++ = *ptr2++;
 }
 else if ((base_target_tp == integer_typep) ||
          (target_tp->form == ENUM_FORM)) {
   /* Range check assignment to integer or enumeration subrange */
   if ((target_tp->form == SUBRANGE_FORM) &&
       ((get_integer(tos) < target_tp->info.subrange.min) ||
        (get_integer(tos) > target_tp->info.subrange.max))) {
     runtime_error(VALUE_OUT_OF_RANGE);
   }

   /* integer := integer */
   /* enumeration := enumeration */
   put_integer(targetp, get_integer(tos));
 }

 else {
   /* real := real */
   put_real(targetp, get_real(tos));
 }

 pop();    /* pop expression value */

 exit_debug("exec_the_assign");
 return;
}                                                   /* end EXEC_THE_ASSIGN */
/***************************************************************************/



/***************************************************************************/
/* exec_string_assign    Execute string := string                          */
/*                                                                         */

exec_string_assign(targetp)
STACK_ITEM_PTR targetp;             /* the LHS */
{
 STRING rhs;                        /* the RHS */
 STRING lhs;
 int num;
 int maxchrs;
 entry_debug("exec_string_assign");

 rhs = get_stacked_string(tos);    /* top of stack points to the string */
 free(targetp->value.string);
 num = strlen(rhs);
 sprintf(dbuffer, "strlen(str) = %d, str = %s\n", num, rhs);
 debug_print(dbuffer);
 lhs = alloc_bytes(num+1);
 sprintf(dbuffer, "lhs = %d", lhs);
 debug_print(dbuffer);
 strcpy(lhs, rhs);
 sprintf(dbuffer, ", str = %s\n", lhs);
 debug_print(dbuffer);

 put_string(targetp, lhs);
/*  set_string(targetp, rhs); */

 exit_debug("exec_string_assign");
 return;
}                                                /* end EXEC_STRING_ASSIGN */
/***************************************************************************/



/***************************************************************************/
/* set_string(var_idp, str)    Attaches string str to variable             */

set_string(var_idp, str)
SYMTAB_NODE_PTR var_idp;           /* variable in the symbol table */
STRING str;                        /* the string */
{
 int num;
 int maxchrs = 527;
 TYPE_STRUCT_PTR strtyp;
 entry_debug("set_string (l2xixstm.c)");

 sprintf(dbuffer, "var_idp = %d\n", var_idp);
 debug_print(dbuffer);
 num = strlen(str);
 sprintf(dbuffer, "num = strlen(str) = %d\n", num);
 debug_print(dbuffer);
 debug_print(str);
 strtyp = var_idp->typep;
/*  maxchrs = var_idp->typep->info.string.max_length; */
/*  maxchrs = strtyp->info.string.max_length; */
 sprintf(dbuffer, "\nmaxchrs = %d\n", maxchrs);
 debug_print(dbuffer);
 if (num > maxchrs) {
   runtime_error(RUNTIME_STRING_TOO_LONG);
   free(var_idp->info);
   var_idp->info = alloc_bytes(maxchrs + 1);
   strncpy(var_idp->info, str, maxchrs);
   var_idp->info[maxchrs] = '\0';
   strtyp->info.string.length = maxchrs;
 }
 else {
/*    free(var_idp->info); */
   var_idp->info = alloc_bytes(num+1);
   strcpy(var_idp->info, str);
/*    strtyp->info.string.length = num; */
 }

 exit_debug("set_string");
}                                                        /* end SET_STRING */
/***************************************************************************/



/***************************************************************************/
/* exec_routine_call(rtn_idp)  Execute procedure or function call.         */
/* return pointer to the type structure                                    */

TYPE_STRUCT_PTR exec_routine_call(rtn_idp)
SYMTAB_NODE_PTR rtn_idp;                     /* routine id */
{
 TYPE_STRUCT_PTR exec_declared_routine_call();
 TYPE_STRUCT_PTR exec_standard_routine_call();
 entry_debug("exec_routine_call");

 if (rtn_idp->defn.info.routine.key == DECLARED) {
   exit_debug("exec_routine_call");
   return(exec_declared_routine_call(rtn_idp));
 }
 else {
   exit_debug("exec_routine_call");
   return(exec_standard_routine_call(rtn_idp));
 }

}                                                /* end exec_routine_call  */
/***************************************************************************/



/***************************************************************************/
/* exec_declared_routine_call(rtn_idp)  Execute a call to a declared       */
/*                                      function or procedure              */
/* return pointer to the type structure                                    */

TYPE_STRUCT_PTR exec_declared_routine_call(rtn_idp)
SYMTAB_NODE_PTR rtn_idp;                     /* routine id */
{
 int old_level = level;                        /* level of caller */
 int new_level = rtn_idp->level + 1;           /* level of callee */
 STACK_ITEM_PTR new_stack_frame_basep;
 STACK_ITEM_PTR hp;                   /* ptr to frame header */
 entry_debug("exec_declared_routine_call");

 /* set up stack frame of callee */
 new_stack_frame_basep = tos + 1;
 push_stack_frame_header(old_level, new_level);

 /* push parameter values onto the stack */
 get_ctoken();
 if (ctoken == LPAREN) {
   exec_actual_parms(rtn_idp);
   get_ctoken();   /* the token after the RPAREN */
 }

 /* set the return address in the new stack frame, and execute callee */
 level = new_level;
 stack_frame_basep = new_stack_frame_basep;
 hp = stack_frame_basep;
/*  put_address(hp->return_address, (code_segmentp - 1)); */
 put_return_address(hp, (code_segmentp - 1));
/*  execute(rtn_idp);      changed this call for EXPRESS */
 exec_algorithm(rtn_idp);

 /* return from callee */
 level = old_level;
 get_ctoken();    /* first token after return */

 exit_debug("exec_declared_routine_call");
 return(rtn_idp->defn.key == PROC_DEFN ? NULL : rtn_idp->typep);

}                                       /* end exec_declared_routine_call  */
/***************************************************************************/



/***************************************************************************/
/* exec_actual_parms(rtn_idp)  Push the values of the actual parameters    */
/*                             onto the stack                              */

exec_actual_parms(rtn_idp)
SYMTAB_NODE_PTR rtn_idp;           /* id of callee routine */
{
 SYMTAB_NODE_PTR formal_idp;           /* formal param id */
 TYPE_STRUCT_PTR formal_tp, actual_tp;
 entry_debug("exec_actual_parms");

 /* loop to execute actual params */
 for (formal_idp = rtn_idp->defn.info.routine.parms;
      formal_idp != NULL;
      formal_idp = formal_idp->next) {
   formal_tp = formal_idp->typep;
   get_ctoken();

   /* value parameter */
   if (formal_idp->defn.key == VALPARM_DEFN) {
     actual_tp = exec_expression();

     /* Range check for a subrange formal param */
     if (formal_tp->form == SUBRANGE_FORM) {
       TYPE_STRUCT_PTR base_formal_tp = base_type(formal_tp);
       XPRSAINT value;

       value = get_integer(tos);
       if ((value < formal_tp->info.subrange.min) ||
           (value > formal_tp->info.subrange.max)) {
         runtime_error(VALUE_OUT_OF_RANGE);
       }
     }

     else if ((formal_tp == real_typep) &&
              (base_type(actual_tp) == integer_typep)) {
       /* real formal := integer actual */
       put_real(tos, (XPRSAREAL) get_integer(tos));
     }

    if ((formal_tp->form == ARRAY_FORM) ||
        (formal_tp->form == ENTITY_FORM)) {
      /* formal param is array or entity. Make a copy */
       int size = formal_tp->size;
       ICT *ptr1 = alloc_array(ICT, size);
       ICT *ptr2 = get_address(tos);      /* ??????????????????? */
       ICT *save_ptr = ptr1;

       while (size--) *ptr1++ = *ptr2++;
       put_address(tos, save_ptr);
     }
   } /* end value param */

   /* a VAR parameter */
   else {
     SYMTAB_NODE_PTR idp = get_symtab_cptr();
     exec_variable(idp, VARPARM_USE);
   }

 } /* end for loop */

 exit_debug("exec_actual_parms");
}                                                /* end exec_actual_parms  */
/***************************************************************************/



/***************************************************************************/
/* exec_compound_statement()  Execute a compound statement                 */
/*                                                                         */

exec_compound_statement()
{
 entry_debug("exec_compound_statement");

 get_ctoken();
 while (ctoken != END) exec_statement();
 get_ctoken();

 exit_debug("exec_compound_statement");
 return;
}                                          /* end exec_compound_statement  */
/***************************************************************************/



/***************************************************************************/
/* exec_case_statement()  Execute a CASE statement                         */
/*                        CASE <expr> OF                                   */
/*                           <case-branch>                                 */
/*                        END                                              */

exec_case_statement()
{
 XPRSAINT case_expr_value;                 /* CASE expr value */
 XPRSAINT case_label_count;                /* CASE label count */
 XPRSAINT case_label_value;                /* CASE label value */
 ADDRESS branch_table_location;       /* branch table address */
 ADDRESS case_branch_location;        /* CASE branch address */
 TYPE_STRUCT_PTR case_expr_tp;        /* CASE expr type */
 BOOLEAN done = FALSE;
 BOOLEAN found_otherwise = FALSE;
 ADDRESS otherwise_location;
 entry_debug("exec_case_statement");

 get_ctoken();               /* token after CASE */
 branch_table_location = get_address_cmarker();

 /* evaluate the CASE expr */
 get_ctoken();
 case_expr_tp = exec_expression();
 case_expr_value = get_integer(tos);
 pop();         /* expression value */

 /* search the branch table for the expr value */
 code_segmentp = branch_table_location;
 get_ctoken();
 case_label_count = get_cinteger();
 while (!done && case_label_count--) {
   case_label_value = get_cinteger();
   case_branch_location = get_caddress();
   done = case_label_value == case_expr_value;
   if (case_label_value == XOTHERWISE) {
     found_otherwise = TRUE;
     otherwise_location = case_branch_location;
   }
 }

 /* if found, goto the appropriate CASE branch */
 if (case_label_count >= 0) {
   code_segmentp = case_branch_location;
   get_ctoken();
   exec_statement();


   code_segmentp = get_address_cmarker();
   get_ctoken();
 }
 else if (found_otherwise) {
   code_segmentp = otherwise_location;
   get_ctoken();
   exec_statement();

   code_segmentp = get_address_cmarker();
   get_ctoken();
 }
 else {
   runtime_error(INVALID_CASE_VALUE);
 }

 exit_debug("exec_case_statement");
 return;
}                                               /* end exec_case_statement */
/***************************************************************************/





/***************************************************************************/
/* exec_if_statement()  Execute an IF statement                            */
/*                      IF <expr> THEN <stmt> END_IF                       */
/*               or                                                        */
/*                      IF <expr> THEN <stmt> ELSE <stmt> END_IF           */

exec_if_statement()
{
 ADDRESS false_location;               /* address of false branch */
 BOOLEAN test;
 entry_debug("exec_if_statement");

 get_ctoken();               /* token after if */
 false_location = get_address_cmarker();

 /* evaluate the boolean expression */
 get_ctoken();
 exec_expression();
 test = get_logical(tos) == TRUE_REP;
 pop();                     /* boolean value */

 if (test) {    /* do the TRUE branch */
   get_ctoken();        /* token after THEN */
   while (ctoken != ELSE && ctoken != XEND_IF) exec_statement();
     if (ctoken == ELSE) {
       get_ctoken();
       code_segmentp = get_address_cmarker();
       get_ctoken();       /* token after false stmt */
   }
 }
 else {           /* do the ELSE branch if there is one */
   code_segmentp = false_location;
   get_ctoken();

   if (ctoken == ELSE ) {
     get_ctoken();
     get_address_cmarker();      /* skip the address marker */

     get_ctoken();
     while(ctoken != XEND_IF) exec_statement();
   }
 }
 get_ctoken(); /* after the END_IF */


 exit_debug("exec_if_statement");
 return;
}                                                 /* end exec_if_statement */
/***************************************************************************/



/***************************************************************************/
/* exec_grepeat_statement()  Execute an EXPRESS REPEAT statement           */
/*    REPEAT [ <inc_control> ] <while_control> <until_control>             */
/*           <stmt-list> END_REPEAT;                                       */
/*  at entry: ctoken is REPEAT                                             */
/*  at exit:  ctoken is after END_REPEAT;                                  */

exec_grepeat_statement()
{
 SYMTAB_NODE_PTR control_idp;            /* control var id */
 TYPE_STRUCT_PTR control_tp;             /* control var type */
 STACK_ITEM_PTR targetp;                 /* ptr to control target */
 ADDRESS loop_start_location;            /* address of start of loop */
 ADDRESS loop_end_location;              /* address of end of loop */
 ADDRESS until_start_location;
 ADDRESS to_start_location;
 ADDRESS while_start_location;
 ADDRESS statements_start_location;
 BOOLEAN loop_done = FALSE;
 BOOLEAN is_increment_control = FALSE;   /* TRUE iff there is an inc. control */
 int control_value;                      /* value of control var */
 int initial_value, final_value, delta_value;
 TOKEN_CODE stmt_tok;
 entry_debug("exec_grepeat_statement (l2xixstm.c)");

 /* the first time through */
 get_ctoken();                   /* code (address marker) token after REPEAT */
 loop_end_location = get_address_cmarker();
   sprintf(dbuffer, "loop_end_location = %d\n", loop_end_location);
   debug_print(dbuffer);
 get_ctoken();                   /* source token after REPEAT */

 if (ctoken == FOR) {            /* increment control */
   is_increment_control = TRUE;
   get_ctoken();                 /* IDENTIFIER for the variable */
    /* get address of control var's stack item */
   control_idp = get_symtab_cptr();
   control_tp = exec_variable(control_idp, TARGET_USE);
   targetp = (STACK_ITEM_PTR) get_address(tos);
   pop();                             /* pop control var's address */

   /* evaluate the initial expression */
   get_ctoken();
   exec_expression();
   initial_value = get_integer(tos);
   pop();                /* initial value */
   put_integer(targetp, initial_value);
   control_value = initial_value;

   /* evaluate the final expression */
   get_ctoken();
   to_start_location = code_segmentp -1;
     sprintf(dbuffer, "to_start_location = %d\n", to_start_location);
     debug_print(dbuffer);
   exec_expression();
   final_value = get_integer(tos);
   pop();                /* final value */

   /* get the increment */
   get_ctoken();
   exec_expression();
   delta_value = get_integer(tos);
   pop();                /* delta value */
     /* check the bound */
     if ((delta_value >= 0 && control_value > final_value) ||
         (delta_value < 0  && control_value < final_value)) {
       code_segmentp = loop_end_location;
       get_ctoken();
       loop_done = TRUE;
     }
     if (loop_done) {
       exit_debug("exec_grepeat_statement");
       return;
     }
 }

 /* check the WHILE condition */
 get_ctoken();
 while_start_location = code_segmentp -1;
     sprintf(dbuffer, "while_start_location = %d\n", while_start_location);
     debug_print(dbuffer);
 exec_expression();
 if (get_logical(tos) == FALSE_REP) {    /* finished */
   code_segmentp = loop_end_location;
   get_ctoken();
   loop_done = TRUE;
 }
 pop();                             /* the WHILE value */
 if (loop_done) {
   exit_debug("exec_grepeat_statement");
   return;
 }

 /* skip the UNTIL condition */
 get_ctoken();
 until_start_location = code_segmentp -1;
     sprintf(dbuffer, "until_start_location = %d\n", until_start_location);
     debug_print(dbuffer);
 while (ctoken != STATEMENT_MARKER) get_ctoken();
 statements_start_location = code_segmentp -1;
     sprintf(dbuffer, "statements_start_location = %d\n", statements_start_location);
     debug_print(dbuffer);

 /* do the statements */
 do {
   stmt_tok = exec_statement();
   if (stmt_tok == XSKIP) {
     code_segmentp = until_start_location;
     break;
   }
   else if (stmt_tok == XESCAPE) {
     code_segmentp = loop_end_location;
     get_ctoken();
     loop_done = TRUE;
     pop();
     exit_debug("exec_grepeat_statement");
     return;
   }
 }  while (ctoken != XEND_REPEAT);

 /* This finishes the first pass, do subsequent passes */
 do {
   /* check the UNTIL expression */
   code_segmentp = until_start_location;
   get_ctoken();
   exec_expression();
   if (get_logical(tos) == TRUE_REP) {    /* finished */
     code_segmentp = loop_end_location;
     get_ctoken();
     loop_done = TRUE;
   }
   pop();                                 /* the UNTIL value */
   if (loop_done) {
     exit_debug("exec_grepeat_statement");
     return;
   }

   /* increment control now */
   if (is_increment_control) {
     /* perform the increment */
     control_value = get_integer(targetp) + delta_value;
     put_integer(targetp, control_value);
     /* do the check */
     code_segmentp = to_start_location;
     get_ctoken();
     exec_expression();
     get_integer(tos);
     if ((delta_value >= 0 && control_value > final_value) ||
         (delta_value < 0  && control_value < final_value)) {
       code_segmentp = loop_end_location;
       get_ctoken();
       loop_done = TRUE;
     }
     pop();                     /* the to value */
     if (loop_done) {
       exit_debug("exec_grepeat_statement");
       return;
     }
   }

     /* check the WHILE */
   code_segmentp = while_start_location;
   get_ctoken();
   exec_expression();
   if (get_logical(tos) == FALSE_REP) {
     code_segmentp = loop_end_location;
     get_ctoken();
     loop_done = TRUE;
   }
   pop();                                 /* the WHILE value */
   if (loop_done) {
     exit_debug("exec_grepeat_statement");
     return;
   }

   /* and now back to executing the statements */
   code_segmentp = statements_start_location;
   get_ctoken();
   do {
     exec_statement();
   } while (ctoken != XEND_REPEAT);
   /* start again checking the UNTIL condition */
   code_segmentp = until_start_location;
 }   while(TRUE);


 exit_debug("exec_grepeat_statement");
 return;

}                                            /* end EXEC_GREPEAT_STATEMENT */
/***************************************************************************/

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.