/*****************************************************************************
FILE : $Source: /projects/higgs1/SNNS/CVS/SNNS/tools/sources/icopjmp.c,v $
SHORTNAME : icopjmp
SNNS VERSION : 4.2
PURPOSE : Intermediate code (IC) functions for SNNS batch interpreter:
assignment, arithmetic and logical operators, jumps
Pointers to these functions are inserted in the
intermediate code table by the grammar
and are executed during intermediate code
interpretation (run())
NOTES :
AUTHOR : Jens Wieland
DATE :
CHANGED BY :
RCS VERSION : $Revision: 1.6 $
LAST CHANGE : $Date: 1998/03/03 14:09:13 $
Copyright (c) 1990-1995 SNNS Group, IPVR, Univ. Stuttgart, FRG
Copyright (c) 1996-1998 SNNS Group, WSI, Univ. Tuebingen, FRG
******************************************************************************/
#include <config.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include "symtab.h"
#include "ictab.h"
#include "icopjmp.ph"
#include "glob_typ.h" /* SNNS-Kernel: Global Datatypes and Constants */
#include "error.h"
#define D( x )
/*****************************************************************************
FUNCTION : assign
PURPOSE : assigns res the value of arg
RETURNS :
NOTES : argument dmy is not used, value ignored
UPDATE :
******************************************************************************/
void assign(St_ptr_type res, St_ptr_type arg, St_ptr_type dmy)
{
Data_type arg_type;
Val_type arg_val;
/* don't write to built-in variables: */
if (st_get_ro(res))
err_prt("Assignment to constant or built-in variable");
/* assign value and type: */
st_get_val_type(arg, &arg_type, &arg_val);
if (arg_type == UNKNOWN)
err_prt("Right side of assignment is undefined");
st_set_val_type(res, arg_type, arg_val);
}
/*****************************************************************************
unary arithmetical operators
******************************************************************************/
/*****************************************************************************
FUNCTION : sq_rt
PURPOSE : square root
argument res is assigned the square root of op1
RETURNS :
NOTES : argument op2 is not used, value ignored
UPDATE :
******************************************************************************/
void sq_rt(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type;
Val_type res_val, op1_val;
st_get_val_type(op1, &op1_type, &op1_val);
/* check wether operand is numeric: */
if (! ((op1_type == INT) || (op1_type == REAL )))
err_prt("Invalid operand type for 'sqrt'");
/* check wether operand is positive: */
if (((op1_type == REAL) ? op1_val.real_val : op1_val.int_val) < 0 )
err_prt("Argument for 'sqrt' has negative value");
/* calculate square root: */
res_type = REAL;
res_val.real_val =
sqrt((double)((op1_type == REAL) ? op1_val.real_val : op1_val.int_val));
/* set type and value of result: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : ln
PURPOSE : natural logarithm
argument res is assigned the natural logarithm of op1
RETURNS :
NOTES : argument op2 is not used, value ignored
UPDATE :
******************************************************************************/
void ln(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type;
Val_type res_val, op1_val;
st_get_val_type(op1, &op1_type, &op1_val);
/* check wether operand is numeric: */
if (! ((op1_type == INT) || (op1_type == REAL )))
err_prt("Invalid operand type for 'ln'");
/* check wether operand is greater than 0: */
if (((op1_type == REAL) ? op1_val.real_val : op1_val.int_val) <= 0 )
err_prt("Argument for 'ln' is zero or negative");
/* calculate ln: */
res_type = REAL;
res_val.real_val =
log((double)((op1_type == REAL) ? op1_val.real_val : op1_val.int_val));
/* set type and value of result: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : lg
PURPOSE : base-10 logarithm
argument res is assigned the base-10 logarithm of op1
RETURNS :
NOTES : argument op2 is not used, value ignored
UPDATE :
******************************************************************************/
void lg(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type;
Val_type res_val, op1_val;
st_get_val_type(op1, &op1_type, &op1_val);
/* check wether operand is numeric: */
if (! ((op1_type == INT) || (op1_type == REAL )))
err_prt("Invalid operand type for 'log'");
/* check wether operand is greater than 0: */
if (((op1_type == REAL) ? op1_val.real_val : op1_val.int_val) <= 0 )
err_prt("Argument for 'log' is zero or negative");
/* calculate log: */
res_type = REAL;
res_val.real_val =
log10((double)((op1_type == REAL) ? op1_val.real_val : op1_val.int_val));
/* set type and value of result: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
binary arithmetical operators
******************************************************************************/
/*****************************************************************************
FUNCTION : add
PURPOSE : integer, real and string add
argument res is assigned the result of op1 + op2
strings are concatenated; if one operand is of string type and
the other is not, the latter is converted to string type
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void add(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* First wipe old memory entry if needed -- if this is not done, heavy
string manipulation in the interpreter causes uncontrolable memory use! */
st_get_val_type(res, &res_type, &res_val);
if (res_type == STRING) {
if (res_val.string_val != NULL) {
free (res_val.string_val);
res_val.string_val = NULL;
st_set_val_type(res, res_type, res_val);
}
}
/* check whether operands are numeric or strings: */
if (!( ((op1_type == INT) || (op1_type == REAL ) || (op1_type == STRING ))
&& ((op2_type == INT) || (op2_type == REAL ) || (op2_type == STRING ))) )
err_prt("Invalid operand type(s) for '+'");
/* add operands according to their types: */
if ((op1_type == INT) && (op2_type == INT ))
{
/* integer add: */
res_type = INT;
res_val.int_val = op1_val.int_val + op2_val.int_val;
D( printf("int add: %d + %d = %d\n",
op1_val.int_val, op2_val.int_val, res_val.int_val); )
}
else
if ( ((op1_type == INT) || (op1_type == REAL ))
&& ((op2_type == INT) || (op2_type == REAL )) )
{
/* real add, if one or both of the operands are real: */
res_type = REAL;
res_val.real_val =
((op1_type == REAL) ? op1_val.real_val : op1_val.int_val)
+ ((op2_type == REAL) ? op2_val.real_val : op2_val.int_val);
D( printf("real add: %f\n",res_val.real_val); )
}
else
/* at least one operand seems to be a string */
{
char *s1, *s2; /* s1 must have space for the strcat operation below */
switch (op1_type){
case INT:
s1 = malloc (20);
sprintf(s1, "%d", op1_val.int_val);
break;
case REAL:
s1 = malloc (20);
sprintf(s1, "%f", op1_val.real_val);
break;
case STRING:
s1 = strdup(op1_val.string_val);
break;
default:
break; /* gcc, be quiet with -Wall */
}
switch (op2_type){
case INT:
s2 = malloc (20);
sprintf(s2, "%d", op2_val.int_val);
break;
case REAL:
s2 = malloc (20);
sprintf(s2, "%f", op2_val.real_val);
break;
case STRING:
s2 = strdup(op2_val.string_val);
break;
default:
break;
}
/* set the result type */
res_type = STRING;
/* set the result value */
res_val.string_val = (char *) malloc(strlen(s1) + strlen(s2) + 1);
if (res_val.string_val == NULL) err_prt(ERR_MEM);
/* concatenate the strings by first copying s1 and then
concatenating s2 behind that; copy the result to the ST: */
strcpy(res_val.string_val, s1);
strcat(res_val.string_val, s2);
/* Remember to FREE the allocated memory... */
free (s1); free (s2);
D( printf("str add: %s\n", res_val.string_val); )
}
/* set type and value of result according to add operation: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : sub
PURPOSE : integer and real subtraction
argument res is assigned the result of op1 - op2
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void sub(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are numeric: */
if (!( ((op1_type == INT) || (op1_type == REAL ))
&& ((op2_type == INT) || (op2_type == REAL ))) )
err_prt("Invalid operand type(s) for '-'");
/* subtract operands according to their types: */
if ((op1_type == REAL) || (op2_type == REAL ))
{
/* real subtract, if one or both of the operands are real: */
res_type = REAL;
res_val.real_val =
((op1_type == REAL) ? op1_val.real_val : op1_val.int_val)
- ((op2_type == REAL) ? op2_val.real_val : op2_val.int_val);
}
else
{
/* integer subtract: */
res_type = INT;
res_val.int_val = op1_val.int_val - op2_val.int_val;
}
/* set type and value of result: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : mult
PURPOSE : integer and real multiply
argument res is assigned the result of op1 * op2
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void mult(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are numeric: */
if (!( ((op1_type == INT) || (op1_type == REAL ))
&& ((op2_type == INT) || (op2_type == REAL ))) )
err_prt("Invalid operand type(s) for '*'");
/* multiply operands according to their types: */
if ((op1_type == REAL) || (op2_type == REAL ))
{
/* real multiply, if one or both of the operands are real: */
res_type = REAL;
res_val.real_val =
((op1_type == REAL) ? op1_val.real_val : op1_val.int_val)
* ((op2_type == REAL) ? op2_val.real_val : op2_val.int_val);
}
else
{
/* integer multiply: */
res_type = INT;
res_val.int_val = op1_val.int_val * op2_val.int_val;
}
/* set type and value of result: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : dvde
PURPOSE : real division
argument res is assigned the result of op1 / op2
integer type arguments are treated like reals
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void dvde(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are numeric: */
if (!( ((op1_type == INT) || (op1_type == REAL ))
&& ((op2_type == INT) || (op2_type == REAL ))) )
err_prt("Invalid operand type(s) for '/'");
/* check wether the divisor is zero: */
if ((Real_type)((op2_type == REAL) ? op2_val.real_val : op2_val.int_val)
== 0.0)
err_prt("Division by zero attempted within '/'");
/* divide operands: */
res_type = REAL;
res_val.real_val =
((op1_type == REAL) ? op1_val.real_val : op1_val.int_val)
/ ((op2_type == REAL) ? op2_val.real_val : op2_val.int_val);
/* set type and value of result: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : intdiv
PURPOSE : integer division
argument res is assigned the result of op1 / op2
the value of res is truncated to its integer part
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void intdiv(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are integers: */
if (! ((op1_type == INT) && (op2_type == INT)))
err_prt("Invalid operand type(s) for 'div'");
/* perform integer division: */
if (op2_val.int_val == 0)
err_prt("Division by zero attempted within 'div'");
res_type = INT;
res_val.int_val = op1_val.int_val / op2_val.int_val;
/* set type and value of result: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : mod
PURPOSE : integer modulo operation
argument res is assigned the result of op1 mod op2
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void mod(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are integers: */
if (! ((op1_type == INT) && (op2_type == INT)))
err_prt("Invalid operand type(s) for 'mod'");
/* perform modulo operation: */
if (op2_val.int_val == 0)
err_prt("Division by zero attempted within 'mod'");
res_type = INT;
res_val.int_val = op1_val.int_val % op2_val.int_val;
/* set type and value of result: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : bmraise
PURPOSE : power of
argument res is assigned the result of op1 raised to the
power of op2
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void bmraise(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are numeric: */
if (!( ((op1_type == INT) || (op1_type == REAL ))
&& ((op2_type == INT) || (op2_type == REAL ))) )
err_prt("Invalid operand type(s) for '**' resp. '^'");
/* check wether the operands are valid: */
if ((((op1_type == REAL) ? op1_val.real_val : op1_val.int_val) < 0)
&& (op2_type == REAL) )
err_prt(
"Arg 2 of '**' resp. '^' must be of integral type if arg 1 is negative");
/* raise op1 to the power of op2: */
res_type = REAL;
res_val.real_val =
pow((double)((op1_type == REAL) ? op1_val.real_val : op1_val.int_val),
(double)((op2_type == REAL) ? op2_val.real_val : op2_val.int_val));
/* set type and value of result: */
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
logical operators
******************************************************************************/
/*****************************************************************************
FUNCTION : not
PURPOSE : boolean not
RETURNS :
NOTES : argument op2 is not used, value ignored
UPDATE :
******************************************************************************/
void not(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type;
Val_type res_val, op1_val;
st_get_val_type(op1, &op1_type, &op1_val);
/* check wether operand is of boolean type: */
if (op1_type == BOOL)
res_val.bool_val = ! op1_val.bool_val;
else
err_prt("Invalid operand type for 'not'");
res_type = BOOL;
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : and
PURPOSE : boolean and
TRUE and TRUE evaluates to TRUE, all else to FALSE
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void and(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are of boolean type: */
if ((op1_type == BOOL) && (op2_type == BOOL ))
res_val.bool_val = op1_val.bool_val && op2_val.bool_val;
else
err_prt("Invalid operand type(s) for 'and'");
res_type = BOOL;
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : or
PURPOSE : boolean or
FALSE or FALSE evaluates to FALSE, all else to TRUE
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void or(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are of boolean type: */
if ((op1_type == BOOL) && (op2_type == BOOL ))
res_val.bool_val = op1_val.bool_val || op2_val.bool_val;
else
err_prt("Invalid operand type(s) for 'or'");
res_type = BOOL;
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : less
PURPOSE : integer, real and boolean less
FALSE < TRUE evaluates to TRUE, all else to FALSE
integers and reals can be compared
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void less(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are of compatible type: */
if ((op1_type == BOOL) && (op2_type == BOOL ))
res_val.bool_val = op1_val.bool_val < op2_val.bool_val;
else
if ( ((op1_type == REAL) || (op1_type == INT))
&& ((op2_type == REAL ) || (op2_type == INT )) )
res_val.bool_val =
( ((op1_type == REAL) ? op1_val.real_val : op1_val.int_val)
< ((op2_type == REAL) ? op2_val.real_val : op2_val.int_val) )
? TRUE : FALSE;
/* ...in words: compare the appropriate operands */
else
err_prt("Invalid operand type(s) for '<'");
res_type = BOOL;
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : greater
PURPOSE : integer, real and boolean greater
TRUE > FALSE evaluates to TRUE, all else to FALSE
integers and reals can be compared
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void greater(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are of compatible type: */
if ((op1_type == BOOL) && (op2_type == BOOL ))
res_val.bool_val = op1_val.bool_val > op2_val.bool_val;
else
if ( ((op1_type == REAL) || (op1_type == INT))
&& ((op2_type == REAL ) || (op2_type == INT )) )
res_val.bool_val =
( ((op1_type == REAL) ? op1_val.real_val : op1_val.int_val)
> ((op2_type == REAL) ? op2_val.real_val : op2_val.int_val) )
? TRUE : FALSE;
/* ...in words: compare the appropriate operands */
else
err_prt("Invalid operand type(s) for '>'");
res_type = BOOL;
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : less_eq
PURPOSE : integer, real and boolean less than or equal
TRUE <= FALSE evaluates to FALSE, all else to TRUE
integers and reals can be compared
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void less_eq(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are of compatible type: */
if ((op1_type == BOOL) && (op2_type == BOOL ))
res_val.bool_val = op1_val.bool_val <= op2_val.bool_val;
else
if ( ((op1_type == REAL) || (op1_type == INT))
&& ((op2_type == REAL ) || (op2_type == INT )) )
res_val.bool_val =
( ((op1_type == REAL) ? op1_val.real_val : op1_val.int_val)
<= ((op2_type == REAL) ? op2_val.real_val : op2_val.int_val) )
? TRUE : FALSE;
/* ...in words: compare the appropriate operands */
else
err_prt("Invalid operand type(s) for '<='");
res_type = BOOL;
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : great_eq
PURPOSE : integer, real and boolean greater than or equal
FALSE >= TRUE evaluates to FALSE, all else to TRUE
integers and reals can be compared
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void great_eq(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are of compatible type: */
if ((op1_type == BOOL) && (op2_type == BOOL ))
res_val.bool_val = op1_val.bool_val >= op2_val.bool_val;
else
if ( ((op1_type == REAL) || (op1_type == INT))
&& ((op2_type == REAL ) || (op2_type == INT )) )
res_val.bool_val =
( ((op1_type == REAL) ? op1_val.real_val : op1_val.int_val)
>= ((op2_type == REAL) ? op2_val.real_val : op2_val.int_val) )
? TRUE : FALSE;
/* ...in words: compare the appropriate operands */
else
err_prt("Invalid operand type(s) for '>='");
res_type = BOOL;
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : eq
PURPOSE : integer, real, string and boolean compare
compares 2 arguments of same type for equality
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void eq(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are of same type: */
if ((op1_type == BOOL) && (op2_type == BOOL))
res_val.bool_val = op1_val.bool_val == op2_val.bool_val;
else
if ((op1_type == REAL) && (op2_type == REAL))
res_val.bool_val = (op1_val.real_val == op2_val.real_val) ? TRUE : FALSE;
else
if ((op1_type == INT) && (op2_type == INT))
res_val.bool_val = (op1_val.int_val == op2_val.int_val) ? TRUE : FALSE;
else
if ((op1_type == STRING) && (op2_type == STRING))
res_val.bool_val =
(!strcmp(op1_val.string_val, op2_val.string_val)) ? TRUE : FALSE;
else
err_prt("Invalid operand type(s) for '=='");
res_type = BOOL;
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
FUNCTION : not_eq
PURPOSE : integer, real and boolean compare
compares 2 arguments of same type for unequality
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void not_eq(St_ptr_type res, St_ptr_type op1, St_ptr_type op2)
{
Data_type res_type, op1_type, op2_type;
Val_type res_val, op1_val, op2_val;
st_get_val_type(op1, &op1_type, &op1_val);
st_get_val_type(op2, &op2_type, &op2_val);
/* check wether operands are of same type (boolean, int or real): */
if ((op1_type == BOOL) && (op2_type == BOOL ))
res_val.bool_val = op1_val.bool_val != op2_val.bool_val;
else
if ((op1_type == REAL) && (op2_type == REAL ))
res_val.bool_val = (op1_val.real_val != op2_val.real_val) ? TRUE : FALSE;
else
if ((op1_type == INT) && (op2_type == INT ))
res_val.bool_val = (op1_val.int_val != op2_val.int_val) ? TRUE : FALSE;
else
err_prt("Invalid operand type(s) for '!=' resp. '<>'");
res_type = BOOL;
st_set_val_type(res, res_type, res_val);
}
/*****************************************************************************
jump-functions
******************************************************************************/
/*****************************************************************************
FUNCTION : jmp
PURPOSE : unconditional jump to jmp_pos
RETURNS :
NOTES : arg is unused, it's value ignored
UPDATE :
******************************************************************************/
void jmp(Ic_ptr_type jmp_pos, St_ptr_type arg)
/* jump to jmp_pos-1 because interpreter loop adds 1 to ic_pc immediately
after execution of the jump command
*/
{
if (jmp_pos == 0) /* bp_backpatch could not insert a target */
warn_prt("Continue found outside of a block; ignored");
else
set_ic_pc(jmp_pos-1);
}
/*****************************************************************************
FUNCTION : jmp_true
PURPOSE : jump to jmp_pos if arg is TRUE
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void jmp_true(Ic_ptr_type jmp_pos, St_ptr_type arg)
/* jmp_pos-1 because interpreter loop adds 1 to ic_pc immediately
after execution of the jump command
*/
{
Data_type arg_type;
Val_type arg_val;
st_get_val_type(arg, &arg_type, &arg_val);
if (arg_type != BOOL)
err_prt("Boolean type expression expected");
if (arg_val.bool_val == TRUE) set_ic_pc(jmp_pos-1);
}
/*****************************************************************************
FUNCTION : jmp_false
PURPOSE : jump to jmp_pos if arg is FALSE
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void jmp_false(Ic_ptr_type jmp_pos, St_ptr_type arg)
/* jmp_pos-1 because interpreter loop adds 1 to ic_pc immediately
after execution of the jump command
*/
{
Data_type arg_type;
Val_type arg_val;
st_get_val_type(arg, &arg_type, &arg_val);
if (arg_type != BOOL)
err_prt("Boolean type expression expected");
if(arg_val.bool_val == FALSE) set_ic_pc(jmp_pos-1);
}
syntax highlighted by Code2HTML, v. 0.9.1