1306 lines
34 KiB
C
1306 lines
34 KiB
C
/*
|
|
eoperators.c: this file contains all of the operators called from
|
|
inside eval_instruction() in interpret.c.
|
|
*/
|
|
|
|
#define SUPPRESS_COMPILER_INLINES
|
|
#include "std.h"
|
|
#include "lpc_incl.h"
|
|
#include "efuns_incl.h"
|
|
#include "backend.h"
|
|
#include "parse.h"
|
|
#ifdef TRACE
|
|
#include "comm.h"
|
|
#endif
|
|
#include "compiler.h"
|
|
#include "simul_efun.h"
|
|
#include "eoperators.h"
|
|
|
|
INLINE void f_and()
|
|
{
|
|
if (sp->type == T_ARRAY && (sp - 1)->type == T_ARRAY) {
|
|
sp--;
|
|
sp->u.arr = intersect_array((sp + 1)->u.arr, sp->u.arr);
|
|
return;
|
|
}
|
|
CHECK_TYPES(sp - 1, T_NUMBER, 1, F_AND);
|
|
CHECK_TYPES(sp, T_NUMBER, 2, F_AND);
|
|
sp--;
|
|
sp->u.number &= (sp + 1)->u.number;
|
|
sp->subtype = 0;
|
|
}
|
|
|
|
INLINE void
|
|
f_and_eq()
|
|
{
|
|
svalue_t *argp;
|
|
|
|
argp = (sp--)->u.lvalue;
|
|
|
|
if (argp->type == T_ARRAY && sp->type == T_ARRAY) {
|
|
sp->u.arr = argp->u.arr = intersect_array(argp->u.arr, sp->u.arr);
|
|
sp->u.arr->ref++; /* since we put it in two places */
|
|
return;
|
|
}
|
|
if (argp->type != T_NUMBER)
|
|
error("Bad left type to &=\n");
|
|
if (sp->type != T_NUMBER)
|
|
error("Bad right type to &=\n");
|
|
sp->u.number = argp->u.number &= sp->u.number;
|
|
sp->subtype = 0;
|
|
}
|
|
|
|
INLINE void
|
|
f_div_eq()
|
|
{
|
|
svalue_t *argp = (sp--)->u.lvalue;
|
|
|
|
switch (argp->type | sp->type) {
|
|
|
|
case T_NUMBER:
|
|
{
|
|
if (!sp->u.number) error("Division by 0nn\n");
|
|
sp->u.number = argp->u.number /= sp->u.number;
|
|
sp->subtype = 0;
|
|
break;
|
|
}
|
|
|
|
case T_REAL:
|
|
{
|
|
if (sp->u.real == 0.0) error("Division by 0rr\n");
|
|
sp->u.real = argp->u.real /= sp->u.real;
|
|
break;
|
|
}
|
|
|
|
case T_NUMBER|T_REAL:
|
|
{
|
|
if (sp->type == T_NUMBER) {
|
|
if (!sp->u.number) error("Division by 0rn\n");
|
|
sp->u.real = argp->u.real /= sp->u.number;
|
|
sp->type = T_REAL;
|
|
} else {
|
|
if (sp->u.real == 0.0) error("Division by 0nr\n");
|
|
sp->u.real = argp->u.number /= sp->u.real;
|
|
}
|
|
break;
|
|
}
|
|
|
|
default:
|
|
{
|
|
if (!(sp->type & (T_NUMBER|T_REAL))) error("Bad right type to /=\n");
|
|
else error("Bad left type to /=\n");
|
|
}
|
|
}
|
|
}
|
|
|
|
INLINE void
|
|
f_eq()
|
|
{
|
|
int i;
|
|
|
|
switch (sp->type|(sp-1)->type) {
|
|
case T_NUMBER:
|
|
{
|
|
--sp;
|
|
sp->u.number = sp->u.number == (sp+1)->u.number;
|
|
sp->subtype = 0;
|
|
return;
|
|
}
|
|
|
|
case T_REAL:
|
|
{
|
|
--sp;
|
|
sp->type = T_NUMBER;
|
|
sp->u.number = sp->u.real == (sp+1)->u.real;
|
|
sp->subtype = 0;
|
|
return;
|
|
}
|
|
|
|
case T_NUMBER|T_REAL:
|
|
{
|
|
if ((--sp)->type == T_NUMBER) {
|
|
sp->u.number = sp->u.number == (sp+1)->u.real;
|
|
}
|
|
else {
|
|
sp->u.number = sp->u.real == (sp+1)->u.number;
|
|
sp->type = T_NUMBER;
|
|
}
|
|
sp->subtype = 0;
|
|
return;
|
|
}
|
|
|
|
case T_ARRAY:
|
|
{
|
|
i = (sp-1)->u.arr == sp->u.arr;
|
|
free_array((sp--)->u.arr);
|
|
free_array(sp->u.arr);
|
|
break;
|
|
}
|
|
|
|
case T_CLASS:
|
|
{
|
|
i = (sp-1)->u.arr == sp->u.arr;
|
|
free_class((sp--)->u.arr);
|
|
free_class(sp->u.arr);
|
|
break;
|
|
}
|
|
|
|
case T_MAPPING:
|
|
{
|
|
i = (sp-1)->u.map == sp->u.map;
|
|
free_mapping((sp--)->u.map);
|
|
free_mapping(sp->u.map);
|
|
break;
|
|
}
|
|
|
|
case T_STRING:
|
|
{
|
|
if (SVALUE_STRLEN_DIFFERS(sp-1,sp))
|
|
i = 0;
|
|
else
|
|
i = !strcmp((sp-1)->u.string, sp->u.string);
|
|
free_string_svalue(sp--);
|
|
free_string_svalue(sp);
|
|
break;
|
|
}
|
|
|
|
case T_OBJECT:
|
|
{
|
|
i = (sp-1)->u.ob == sp->u.ob;
|
|
free_object(&(sp--)->u.ob, "f_eq: 1");
|
|
free_object(&sp->u.ob, "f_eq: 2");
|
|
break;
|
|
}
|
|
|
|
case T_FUNCTION:
|
|
{
|
|
i = (sp-1)->u.fp == sp->u.fp;
|
|
free_funp((sp--)->u.fp);
|
|
free_funp(sp->u.fp);
|
|
break;
|
|
}
|
|
#ifndef NO_BUFFER_TYPE
|
|
case T_BUFFER:
|
|
{
|
|
i = (sp-1)->u.buf == sp->u.buf;
|
|
free_buffer((sp--)->u.buf);
|
|
free_buffer(sp->u.buf);
|
|
break;
|
|
}
|
|
#endif
|
|
default:
|
|
pop_stack();
|
|
free_svalue(sp, "f_eq");
|
|
i = 0;
|
|
}
|
|
/* args are freed, stack pointer points to spot for return value */
|
|
put_number(i);
|
|
}
|
|
|
|
INLINE void
|
|
f_ge()
|
|
{
|
|
int i = sp->type;
|
|
switch ((--sp)->type | i) {
|
|
case T_NUMBER:
|
|
sp->u.number = sp->u.number >= (sp+1)->u.number;
|
|
sp->subtype = 0;
|
|
break;
|
|
case T_REAL:
|
|
i = sp->u.real >= (sp+1)->u.real;
|
|
put_number(i);
|
|
break;
|
|
case T_NUMBER | T_REAL:
|
|
if (i == T_NUMBER) {
|
|
sp->type = T_NUMBER;
|
|
sp->u.number = sp->u.real >= (sp+1)->u.number;
|
|
} else {
|
|
sp->u.number = sp->u.number >= (sp+1)->u.real;
|
|
}
|
|
sp->subtype = 0;
|
|
break;
|
|
case T_STRING:
|
|
i = strcmp(sp->u.string, (sp+1)->u.string) >= 0;
|
|
free_string_svalue(sp + 1);
|
|
free_string_svalue(sp);
|
|
put_number(i);
|
|
break;
|
|
default:
|
|
{
|
|
switch ((sp++)->type) {
|
|
case T_NUMBER:
|
|
case T_REAL:
|
|
bad_argument(sp, T_NUMBER | T_REAL, 2, F_GE);
|
|
case T_STRING:
|
|
bad_argument(sp, T_STRING, 2, F_GE);
|
|
default:
|
|
bad_argument(sp - 1, T_NUMBER | T_STRING | T_REAL, 1, F_GE);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
INLINE void
|
|
f_gt() {
|
|
int i = sp->type;
|
|
switch ((--sp)->type | i) {
|
|
case T_NUMBER:
|
|
sp->u.number = sp->u.number > (sp+1)->u.number;
|
|
sp->subtype = 0;
|
|
break;
|
|
case T_REAL:
|
|
sp->u.number = sp->u.real > (sp+1)->u.real;
|
|
sp->type = T_NUMBER;
|
|
sp->subtype = 0;
|
|
break;
|
|
case T_NUMBER | T_REAL:
|
|
if (i == T_NUMBER) {
|
|
sp->type = T_NUMBER;
|
|
sp->u.number = sp->u.real > (sp+1)->u.number;
|
|
} else sp->u.number = sp->u.number > (sp+1)->u.real;
|
|
sp->subtype = 0;
|
|
break;
|
|
case T_STRING:
|
|
i = strcmp(sp->u.string, (sp+1)->u.string) > 0;
|
|
free_string_svalue(sp+1);
|
|
free_string_svalue(sp);
|
|
put_number(i);
|
|
break;
|
|
default:
|
|
{
|
|
switch ((sp++)->type) {
|
|
case T_NUMBER:
|
|
case T_REAL:
|
|
bad_argument(sp, T_NUMBER | T_REAL, 2, F_GT);
|
|
case T_STRING:
|
|
bad_argument(sp, T_STRING, 2, F_GT);
|
|
default:
|
|
bad_argument(sp-1, T_NUMBER | T_REAL | T_STRING, 1, F_GT);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
INLINE void
|
|
f_le()
|
|
{
|
|
int i = sp->type;
|
|
switch((--sp)->type|i) {
|
|
case T_NUMBER:
|
|
sp->u.number = sp->u.number <= (sp+1)->u.number;
|
|
break;
|
|
|
|
case T_REAL:
|
|
sp->u.number = sp->u.real <= (sp+1)->u.real;
|
|
sp->type = T_NUMBER;
|
|
break;
|
|
|
|
case T_NUMBER|T_REAL:
|
|
if (i == T_NUMBER) {
|
|
sp->type = T_NUMBER;
|
|
sp->u.number = sp->u.real <= (sp+1)->u.number;
|
|
} else sp->u.number = sp->u.number <= (sp+1)->u.real;
|
|
break;
|
|
|
|
case T_STRING:
|
|
i = strcmp(sp->u.string, (sp+1)->u.string) <= 0;
|
|
free_string_svalue(sp+1);
|
|
free_string_svalue(sp);
|
|
sp->type = T_NUMBER;
|
|
sp->u.number = i;
|
|
break;
|
|
|
|
default:
|
|
{
|
|
switch((sp++)->type) {
|
|
case T_NUMBER:
|
|
case T_REAL:
|
|
bad_argument(sp, T_NUMBER | T_REAL, 2, F_LE);
|
|
|
|
case T_STRING:
|
|
bad_argument(sp, T_STRING, 2, F_LE);
|
|
|
|
default:
|
|
bad_argument(sp - 1, T_NUMBER | T_STRING | T_REAL, 1, F_LE);
|
|
}
|
|
}
|
|
}
|
|
sp->subtype = 0;
|
|
}
|
|
|
|
INLINE void
|
|
f_lt() {
|
|
int i = sp->type;
|
|
switch (i | (--sp)->type) {
|
|
case T_NUMBER:
|
|
sp->u.number = sp->u.number < (sp+1)->u.number;
|
|
break;
|
|
case T_REAL:
|
|
sp->u.number = sp->u.real < (sp+1)->u.real;
|
|
sp->type = T_NUMBER;
|
|
break;
|
|
case T_NUMBER|T_REAL:
|
|
if (i == T_NUMBER) {
|
|
sp->type = T_NUMBER;
|
|
sp->u.number = sp->u.real < (sp+1)->u.number;
|
|
} else sp->u.number = sp->u.number < (sp+1)->u.real;
|
|
break;
|
|
case T_STRING:
|
|
i = (strcmp(sp->u.string, (sp + 1)->u.string) < 0);
|
|
free_string_svalue(sp+1);
|
|
free_string_svalue(sp);
|
|
sp->type = T_NUMBER;
|
|
sp->u.number = i;
|
|
break;
|
|
default:
|
|
switch ((sp++)->type) {
|
|
case T_NUMBER:
|
|
case T_REAL:
|
|
bad_argument(sp, T_NUMBER | T_REAL, 2, F_LT);
|
|
case T_STRING:
|
|
bad_argument(sp, T_STRING, 2, F_LT);
|
|
default:
|
|
bad_argument(sp-1, T_NUMBER | T_STRING | T_REAL, 1, F_LT);
|
|
}
|
|
}
|
|
sp->subtype = 0;
|
|
}
|
|
|
|
INLINE void
|
|
f_lsh()
|
|
{
|
|
CHECK_TYPES((sp - 1), T_NUMBER, 1, F_LSH);
|
|
CHECK_TYPES(sp, T_NUMBER, 2, F_LSH);
|
|
sp--;
|
|
sp->u.number <<= (sp + 1)->u.number;
|
|
}
|
|
|
|
INLINE void
|
|
f_lsh_eq()
|
|
{
|
|
svalue_t *argp;
|
|
|
|
|
|
if ((argp = sp->u.lvalue)->type != T_NUMBER)
|
|
error("Bad left type to <<=\n");
|
|
if ((--sp)->type != T_NUMBER)
|
|
error("Bad right type to <<=\n");
|
|
sp->u.number = argp->u.number <<= sp->u.number;
|
|
sp->subtype = 0;
|
|
}
|
|
|
|
INLINE void
|
|
f_mod_eq()
|
|
{
|
|
svalue_t *argp;
|
|
|
|
if ((argp = sp->u.lvalue)->type != T_NUMBER)
|
|
error("Bad left type to %=\n");
|
|
if ((--sp)->type != T_NUMBER)
|
|
error("Bad right type to %=\n");
|
|
if (sp->u.number == 0)
|
|
error("Modulo by 0\n");
|
|
sp->u.number = argp->u.number %= sp->u.number;
|
|
sp->subtype = 0;
|
|
}
|
|
|
|
INLINE void
|
|
f_mult_eq()
|
|
{
|
|
svalue_t *argp = (sp--)->u.lvalue;
|
|
|
|
switch(argp->type | sp->type) {
|
|
case T_NUMBER:
|
|
{
|
|
sp->u.number = argp->u.number *= sp->u.number;
|
|
sp->subtype = 0;
|
|
break;
|
|
}
|
|
|
|
case T_REAL:
|
|
{
|
|
sp->u.real = argp->u.real *= sp->u.real;
|
|
break;
|
|
}
|
|
|
|
case T_NUMBER|T_REAL:
|
|
{
|
|
if (sp->type == T_NUMBER) {
|
|
sp->type = T_REAL;
|
|
sp->u.real = argp->u.real *= sp->u.number;
|
|
}
|
|
else {
|
|
sp->u.real = argp->u.number *= sp->u.real;
|
|
}
|
|
break;
|
|
}
|
|
|
|
case T_MAPPING:
|
|
{
|
|
mapping_t *m = compose_mapping(argp->u.map, sp->u.map,0);
|
|
if (argp->u.map != sp->u.map) {
|
|
pop_stack();
|
|
push_mapping(m);
|
|
}
|
|
break;
|
|
}
|
|
|
|
default:
|
|
{
|
|
if (!(sp->type & (T_NUMBER|T_REAL|T_MAPPING))) error("Bad right type to *=\n");
|
|
else error("Bad left type to *=\n");
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
INLINE void
|
|
f_ne()
|
|
{
|
|
int i;
|
|
|
|
switch (sp->type|(sp-1)->type) {
|
|
case T_NUMBER:
|
|
{
|
|
--sp;
|
|
sp->u.number = sp->u.number != (sp+1)->u.number;
|
|
sp->subtype = 0;
|
|
return;
|
|
}
|
|
|
|
case T_REAL:
|
|
{
|
|
--sp;
|
|
sp->type = T_NUMBER;
|
|
sp->u.number = sp->u.real != (sp+1)->u.real;
|
|
sp->subtype = 0;
|
|
return;
|
|
}
|
|
|
|
case T_NUMBER|T_REAL:
|
|
{
|
|
if ((--sp)->type == T_NUMBER) {
|
|
sp->u.number = sp->u.number != (sp+1)->u.real;
|
|
}
|
|
else {
|
|
sp->u.number = sp->u.real != (sp+1)->u.number;
|
|
sp->type = T_NUMBER;
|
|
}
|
|
sp->subtype = 0;
|
|
return;
|
|
}
|
|
|
|
case T_ARRAY:
|
|
{
|
|
i = (sp-1)->u.arr != sp->u.arr;
|
|
free_array((sp--)->u.arr);
|
|
free_array(sp->u.arr);
|
|
break;
|
|
}
|
|
|
|
case T_CLASS:
|
|
{
|
|
i = (sp-1)->u.arr != sp->u.arr;
|
|
free_class((sp--)->u.arr);
|
|
free_class(sp->u.arr);
|
|
break;
|
|
}
|
|
|
|
case T_MAPPING:
|
|
{
|
|
i = (sp-1)->u.map != sp->u.map;
|
|
free_mapping((sp--)->u.map);
|
|
free_mapping(sp->u.map);
|
|
break;
|
|
}
|
|
|
|
case T_STRING:
|
|
{
|
|
if (SVALUE_STRLEN_DIFFERS(sp-1, sp))
|
|
i = 1;
|
|
else
|
|
i = !!strcmp((sp-1)->u.string, sp->u.string);
|
|
free_string_svalue(sp--);
|
|
free_string_svalue(sp);
|
|
break;
|
|
}
|
|
|
|
case T_OBJECT:
|
|
{
|
|
i = (sp-1)->u.ob != sp->u.ob;
|
|
free_object(&(sp--)->u.ob, "f_ne: 1");
|
|
free_object(&sp->u.ob, "f_ne: 2");
|
|
break;
|
|
}
|
|
|
|
case T_FUNCTION:
|
|
{
|
|
i = (sp-1)->u.fp != sp->u.fp;
|
|
free_funp((sp--)->u.fp);
|
|
free_funp(sp->u.fp);
|
|
break;
|
|
}
|
|
|
|
#ifndef NO_BUFFER_TYPE
|
|
case T_BUFFER:
|
|
{
|
|
i = (sp-1)->u.buf != sp->u.buf;
|
|
free_buffer((sp--)->u.buf);
|
|
free_buffer(sp->u.buf);
|
|
break;
|
|
}
|
|
#endif
|
|
|
|
default:
|
|
pop_stack();
|
|
free_svalue(sp, "f_ne");
|
|
i = 1;
|
|
}
|
|
sp->type = T_NUMBER;
|
|
sp->subtype = 0;
|
|
sp->u.number = i;
|
|
}
|
|
|
|
INLINE void
|
|
f_or()
|
|
{
|
|
if (sp->type == T_ARRAY && (sp - 1)->type == T_ARRAY) {
|
|
sp--;
|
|
sp->u.arr = union_array(sp->u.arr, (sp+1)->u.arr);
|
|
return;
|
|
}
|
|
CHECK_TYPES((sp - 1), T_NUMBER, 1, F_OR);
|
|
CHECK_TYPES(sp, T_NUMBER, 2, F_OR);
|
|
sp--;
|
|
sp->u.number |= (sp + 1)->u.number;
|
|
}
|
|
|
|
INLINE void
|
|
f_or_eq()
|
|
{
|
|
svalue_t *argp;
|
|
|
|
argp = (sp--)->u.lvalue;
|
|
if (argp->type == T_ARRAY && sp->type == T_ARRAY) {
|
|
argp->u.arr = sp->u.arr = union_array(argp->u.arr, sp->u.arr);
|
|
sp->u.arr->ref++; /* because we put it in two places */
|
|
return;
|
|
}
|
|
|
|
if (argp->type != T_NUMBER)
|
|
error("Bad left type to |=\n");
|
|
if (sp->type != T_NUMBER)
|
|
error("Bad right type to |=\n");
|
|
sp->u.number = argp->u.number |= sp->u.number;
|
|
sp->subtype = 0;
|
|
}
|
|
|
|
INLINE void
|
|
f_parse_command()
|
|
{
|
|
svalue_t *arg;
|
|
svalue_t *fp;
|
|
int i;
|
|
int num_arg;
|
|
|
|
/*
|
|
* get number of lvalue args
|
|
*/
|
|
num_arg = EXTRACT_UCHAR(pc);
|
|
pc++;
|
|
|
|
/*
|
|
* type checking on first three required parameters to parse_command()
|
|
*/
|
|
arg = sp - 2;
|
|
CHECK_TYPES(&arg[0], T_STRING, 1, F_PARSE_COMMAND);
|
|
CHECK_TYPES(&arg[1], T_OBJECT | T_ARRAY, 2, F_PARSE_COMMAND);
|
|
CHECK_TYPES(&arg[2], T_STRING, 3, F_PARSE_COMMAND);
|
|
|
|
/*
|
|
* allocate stack frame for rvalues and return value (number of matches);
|
|
* perform some stack manipulation;
|
|
*/
|
|
fp = sp;
|
|
CHECK_STACK_OVERFLOW(num_arg + 1);
|
|
sp += num_arg + 1;
|
|
arg = sp;
|
|
*(arg--) = *(fp--); /* move pattern to top of stack */
|
|
*(arg--) = *(fp--); /* move source object or array to just below
|
|
the pattern */
|
|
*(arg) = *(fp); /* move source string just below the object */
|
|
fp->type = T_NUMBER;
|
|
|
|
/*
|
|
* prep area for rvalues
|
|
*/
|
|
for (i = 1; i <= num_arg; i++)
|
|
fp[i].type = T_INVALID;
|
|
|
|
/*
|
|
* do it...
|
|
*/
|
|
i = parse(arg[0].u.string, &arg[1], arg[2].u.string, &fp[1], num_arg);
|
|
|
|
/*
|
|
* remove mandatory parameters
|
|
*/
|
|
pop_3_elems();
|
|
|
|
/*
|
|
* save return value on stack
|
|
*/
|
|
fp->u.number = i;
|
|
fp->subtype = 0;
|
|
}
|
|
|
|
INLINE void
|
|
f_range (int code)
|
|
{
|
|
int from, to, len;
|
|
|
|
if ((sp-2)->type != T_NUMBER)
|
|
error("Start of range [ .. ] interval must be a number.\n");
|
|
if ((sp-1)->type != T_NUMBER)
|
|
error("End of range [ .. ] interval must be a number.\n");
|
|
|
|
switch(sp->type) {
|
|
case T_STRING:
|
|
{
|
|
const char *res = sp->u.string;
|
|
|
|
len = SVALUE_STRLEN(sp);
|
|
to = (--sp)->u.number;
|
|
if (code & 0x01) to = len - to;
|
|
#ifdef OLD_RANGE_BEHAVIOR
|
|
else if (to < 0)
|
|
to += len;
|
|
#endif
|
|
from = (--sp)->u.number;
|
|
if (code & 0x10) from = len - from;
|
|
#ifdef OLD_RANGE_BEHAVIOR
|
|
else if (from < 0)
|
|
from += len;
|
|
#endif
|
|
if (from < 0) from = 0;
|
|
|
|
if (to < from || from >= len) {
|
|
free_string_svalue(sp+2);
|
|
sp->type = T_STRING;
|
|
sp->subtype = STRING_CONSTANT;
|
|
sp->u.string = "";
|
|
return;
|
|
}
|
|
|
|
if (to >= len - 1) {
|
|
put_malloced_string(string_copy(res + from, "f_range"));
|
|
} else {
|
|
char *tmp;
|
|
tmp = new_string(to - from + 1, "f_range");
|
|
strncpy(tmp, res + from, to - from + 1);
|
|
tmp[to - from + 1] = '\0';
|
|
put_malloced_string(tmp);
|
|
}
|
|
free_string_svalue(sp + 2);
|
|
break;
|
|
}
|
|
#ifndef NO_BUFFER_TYPE
|
|
case T_BUFFER:
|
|
{
|
|
buffer_t *rbuf = sp->u.buf;
|
|
|
|
len = rbuf->size;
|
|
to = (--sp)->u.number;
|
|
if (code & 0x01) to = len - to;
|
|
#ifdef OLD_RANGE_BEHAVIOR
|
|
if (to < 0) to += len;
|
|
#endif
|
|
from = (--sp)->u.number;
|
|
if (code & 0x10) from = len - from;
|
|
#ifdef OLD_RANGE_BEHAVIOR
|
|
if (from < 0) {
|
|
if ((from += len) < 0) from = 0;
|
|
}
|
|
#else
|
|
if (from < 0) from = 0;
|
|
#endif
|
|
if (to < from || from >= len) {
|
|
free_buffer(rbuf);
|
|
put_buffer(null_buffer());
|
|
return;
|
|
}
|
|
if (to >= len) to = len - 1;
|
|
{
|
|
buffer_t *nbuf = allocate_buffer(to - from + 1);
|
|
memcpy(nbuf->item, rbuf->item + from, to - from + 1);
|
|
free_buffer(rbuf);
|
|
put_buffer(nbuf);
|
|
}
|
|
break;
|
|
}
|
|
#endif
|
|
|
|
case T_ARRAY:
|
|
{
|
|
array_t *v = sp->u.arr;
|
|
to = (--sp)->u.number;
|
|
if (code & 0x01) to = v->size - to;
|
|
from = (--sp)->u.number;
|
|
if (code & 0x10) from = v->size - from;
|
|
put_array(slice_array(v, from, to));
|
|
break;
|
|
}
|
|
|
|
default:
|
|
error("Cannot index type '%s' using [ .. ] operator.\n",
|
|
type_name(sp->type));
|
|
}
|
|
}
|
|
|
|
INLINE void
|
|
f_extract_range (int code)
|
|
{
|
|
int from, len;
|
|
|
|
if ((sp-1)->type != T_NUMBER)
|
|
error("Start of range [ .. ] interval must be a number.\n");
|
|
|
|
switch(sp->type) {
|
|
case T_STRING:
|
|
{
|
|
const char *res = sp->u.string;
|
|
|
|
len = SVALUE_STRLEN(sp);
|
|
from = (--sp)->u.number;
|
|
if (code) from = len - from;
|
|
#ifdef OLD_RANGE_BEHAVIOR
|
|
if (from < 0) {
|
|
if ((from += len) < 0) from = 0;
|
|
}
|
|
#else
|
|
if (from < 0) from = 0;
|
|
#endif
|
|
if (from >= len) {
|
|
sp->type = T_STRING;
|
|
sp->subtype = STRING_CONSTANT;
|
|
sp->u.string = "";
|
|
} else
|
|
put_malloced_string(string_copy(res + from, "f_extract_range"));
|
|
free_string_svalue(sp + 1);
|
|
break;
|
|
}
|
|
#ifndef NO_BUFFER_TYPE
|
|
case T_BUFFER:
|
|
{
|
|
buffer_t *rbuf = sp->u.buf;
|
|
buffer_t *nbuf;
|
|
|
|
|
|
len = rbuf->size;
|
|
from = (--sp)->u.number;
|
|
if (code) from = len - from;
|
|
#ifdef OLD_RANGE_BEHAVIOR
|
|
if (from < 0) {
|
|
if ((from += len) < 0) from = 0;
|
|
}
|
|
#else
|
|
if (from < 0) from = 0;
|
|
#endif
|
|
if (from > len) from = len;
|
|
nbuf = allocate_buffer(len - from);
|
|
memcpy(nbuf->item, rbuf->item + from, len - from);
|
|
free_buffer(rbuf);
|
|
put_buffer(nbuf);
|
|
break;
|
|
}
|
|
#endif
|
|
|
|
case T_ARRAY:
|
|
{
|
|
array_t *v = sp->u.arr;
|
|
from = (--sp)->u.number;
|
|
if (code) from = v->size - from;
|
|
put_array(slice_array(v, from, v->size - 1));
|
|
break;
|
|
}
|
|
|
|
default:
|
|
error("Bad argument to [ .. ] range operator.\n");
|
|
}
|
|
}
|
|
|
|
INLINE void
|
|
f_rsh()
|
|
{
|
|
CHECK_TYPES((sp - 1), T_NUMBER, 1, F_RSH);
|
|
CHECK_TYPES(sp, T_NUMBER, 2, F_RSH);
|
|
sp--;
|
|
sp->u.number >>= (sp + 1)->u.number;
|
|
}
|
|
|
|
INLINE void
|
|
f_rsh_eq()
|
|
{
|
|
svalue_t *argp;
|
|
|
|
if ((argp = sp->u.lvalue)->type != T_NUMBER)
|
|
error("Bad left type to >>=\n");
|
|
if ((--sp)->type != T_NUMBER)
|
|
error("Bad right type to >>=\n");
|
|
sp->u.number = argp->u.number >>= sp->u.number;
|
|
sp->subtype = 0;
|
|
}
|
|
|
|
INLINE void
|
|
f_sub_eq()
|
|
{
|
|
svalue_t *argp = (sp--)->u.lvalue;
|
|
|
|
switch(argp->type | sp->type) {
|
|
case T_NUMBER:
|
|
{
|
|
sp->u.number = argp->u.number -= sp->u.number;
|
|
sp->subtype = 0;
|
|
break;
|
|
}
|
|
|
|
case T_REAL:
|
|
{
|
|
sp->u.real = argp->u.real -= sp->u.real;
|
|
break;
|
|
}
|
|
|
|
case T_NUMBER|T_REAL:
|
|
{
|
|
if (sp->type == T_NUMBER) {
|
|
sp->type = T_REAL;
|
|
sp->u.real = argp->u.real -= sp->u.number;
|
|
} else sp->u.real = argp->u.number -= sp->u.real;
|
|
break;
|
|
}
|
|
|
|
case T_ARRAY:
|
|
{
|
|
sp->u.arr = argp->u.arr = subtract_array(argp->u.arr, sp->u.arr);
|
|
sp->u.arr->ref++;
|
|
break;
|
|
}
|
|
|
|
case T_LVALUE_BYTE | T_NUMBER:
|
|
{
|
|
char c;
|
|
|
|
c = *global_lvalue_byte.u.lvalue_byte - sp->u.number;
|
|
|
|
if (global_lvalue_byte.subtype == 0 && c == '\0')
|
|
error("Strings cannot contain 0 bytes.\n");
|
|
*global_lvalue_byte.u.lvalue_byte = c;
|
|
break;
|
|
}
|
|
|
|
default:
|
|
{
|
|
if (!(sp->type & (T_NUMBER|T_REAL|T_ARRAY))) error("Bad right type to -=\n");
|
|
else if (!(argp->type & (T_NUMBER|T_REAL|T_ARRAY))) error("Bad left type to -=\n");
|
|
else error("Arguments to -= do not match in type.\n");
|
|
}
|
|
}
|
|
}
|
|
|
|
/*
|
|
* Structure of F_SWITCH:
|
|
* table type (1 byte)
|
|
* address of table (1 short)
|
|
* address of break (1 short)
|
|
* address of default (1 short)
|
|
* then all the switch code
|
|
* switch table (varies)
|
|
*
|
|
* Table type is either
|
|
* 0xfe - integer labels, direct lookup.
|
|
* Table is followed by 1 int that is minimum key value.
|
|
* Each table entry is a short address to jump to.
|
|
* 0xfN - integer labels. N is size as a power of 2.
|
|
* Each table entry is 1 long (key) followed by 1 short (address).
|
|
* 0xNf - string labels. Otherwise same as for integer labels.
|
|
*
|
|
* For normal string or integer tables, if the address is 0 or 1,
|
|
* the key is the lower end of a range, and the upper end is in
|
|
* the next entry. If it's a 0, the second address indicates a
|
|
* direct lookup table (currently this case is never generated by
|
|
* the compiler). If it's a 1, the second address is used for
|
|
* all keys in the range (corresponds to 'case x..y:' labels).
|
|
*
|
|
* Binary search is used on the normal tables.
|
|
*/
|
|
|
|
/* offsets from 'pc' */
|
|
#define SW_TYPE 0
|
|
#define SW_TABLE 1
|
|
#define SW_ENDTAB 3
|
|
#define SW_DEFAULT 5
|
|
|
|
/* offsets used for range (L_ for lower member, U_ for upper member) */
|
|
#define L_LOWER 0
|
|
#define L_TYPE (sizeof(char *))
|
|
#define L_UPPER (SWITCH_CASE_SIZE)
|
|
#define L_ADDR (SWITCH_CASE_SIZE + sizeof(char *))
|
|
#define U_LOWER (-SWITCH_CASE_SIZE)
|
|
#define U_TYPE (-SWITCH_CASE_SIZE + sizeof(char *))
|
|
#define U_UPPER 0
|
|
#define U_ADDR (sizeof(char *))
|
|
|
|
INLINE void
|
|
f_switch()
|
|
{
|
|
unsigned short offset, end_off;
|
|
long d;
|
|
POINTER_INT s;
|
|
POINTER_INT r;
|
|
long i;
|
|
char *l, *end_tab;
|
|
static unsigned short off_tab[] =
|
|
{
|
|
0 * SWITCH_CASE_SIZE, 1 * SWITCH_CASE_SIZE, 3 * SWITCH_CASE_SIZE,
|
|
7 * SWITCH_CASE_SIZE, 15 * SWITCH_CASE_SIZE, 31 * SWITCH_CASE_SIZE,
|
|
63 * SWITCH_CASE_SIZE, 127 * SWITCH_CASE_SIZE,
|
|
255 * SWITCH_CASE_SIZE, 511 * SWITCH_CASE_SIZE,
|
|
1023 * SWITCH_CASE_SIZE, 2047 * SWITCH_CASE_SIZE,
|
|
4095 * SWITCH_CASE_SIZE,
|
|
};
|
|
|
|
COPY_SHORT(&offset, pc + SW_TABLE);
|
|
COPY_SHORT(&end_off, pc + SW_ENDTAB);
|
|
|
|
if ((i = EXTRACT_UCHAR(pc) >> 4) != 0xf) { /* String table, find correct
|
|
* key */
|
|
if (sp->type == T_NUMBER && !sp->u.number) {
|
|
/* special case: 0 as a string */
|
|
s = 0;
|
|
sp--;
|
|
} else if (sp->type == T_STRING) {
|
|
if (sp->subtype == STRING_SHARED) {
|
|
s = (POINTER_INT)sp->u.string;
|
|
free_string(sp->u.string);
|
|
sp--;
|
|
} else {
|
|
s = (POINTER_INT)findstring(sp->u.string);
|
|
free_string_svalue(sp--);
|
|
}
|
|
if (s == 0) {
|
|
/*
|
|
* Take default case now - else we could be get confused with
|
|
* ZERO_AS_STR_CASE_LABEL.
|
|
*/
|
|
COPY_SHORT(&offset, pc + SW_DEFAULT);
|
|
pc += offset;
|
|
return;
|
|
}
|
|
} else {
|
|
bad_argument(sp, T_STRING, 1, F_SWITCH);
|
|
}
|
|
} else { /* Integer table, check type */
|
|
CHECK_TYPES(sp, T_NUMBER, 1, F_SWITCH);
|
|
s = (sp--)->u.number;
|
|
i = pc[0] & 0xf;
|
|
}
|
|
end_tab = pc + end_off;
|
|
/*
|
|
* i is the table size as a power of 2. Tells us where to start
|
|
* searching. i==14 is a special case.
|
|
*/
|
|
|
|
if (i >= 13) {
|
|
if (i == 14) {
|
|
char *zz = end_tab - SIZEOF_LONG;
|
|
/* fastest switch format : lookup table */
|
|
l = pc + offset;
|
|
COPY_INT(&d, zz);
|
|
/* d is minimum value - see if in range or not */
|
|
s -= d;
|
|
if (s >= 0 && s < (zz-l)/sizeof(short)) {
|
|
COPY_SHORT(&offset, l + s * sizeof(short));
|
|
if (offset) {
|
|
pc += offset;
|
|
return;
|
|
}
|
|
}
|
|
/* default */
|
|
COPY_SHORT(&offset, pc + SW_DEFAULT);
|
|
pc += offset;
|
|
return;
|
|
} else
|
|
fatal("unsupported switch table format.\n");
|
|
}
|
|
|
|
/*
|
|
* l - current entry we are looking at.
|
|
* d - size to add/subtract from l each iteration.
|
|
* s - key we're looking for
|
|
* r - key l is pointing at
|
|
*/
|
|
l = pc + offset + off_tab[i];
|
|
d = (off_tab[i] + SWITCH_CASE_SIZE) >> 1;
|
|
if (d < SWITCH_CASE_SIZE)
|
|
d = 0;
|
|
for (;;) {
|
|
COPY_PTR(&r, l);
|
|
if (s < r) {
|
|
if (d < SWITCH_CASE_SIZE) {
|
|
/* test if entry is part of a range */
|
|
/* Don't worry about reading from F_BREAK (byte before table) */
|
|
COPY_SHORT(&offset, l + U_TYPE);
|
|
if (offset <= 1) {
|
|
COPY_PTR(&r, l + U_LOWER);
|
|
if (s >= r) {
|
|
/* s is in the range */
|
|
COPY_SHORT(&offset, l + U_ADDR);
|
|
if (!offset) {
|
|
/* range with lookup table */
|
|
l = pc + offset +
|
|
(s - r) * sizeof(short);
|
|
COPY_SHORT(&offset, l);
|
|
} /* else normal range and offset is correct */
|
|
break;
|
|
}
|
|
}
|
|
/* key not found, use default address */
|
|
COPY_SHORT(&offset, pc + SW_DEFAULT);
|
|
break;
|
|
} else {
|
|
/* d >= SWITCH_CASE_SIZE */
|
|
l -= d;
|
|
d >>= 1;
|
|
}
|
|
} else if (s > r) {
|
|
if (d < SWITCH_CASE_SIZE) {
|
|
/* test if entry is part of a range */
|
|
COPY_SHORT(&offset, l + L_TYPE);
|
|
if (offset <= 1) {
|
|
COPY_PTR(&r, l + L_UPPER);
|
|
if (s <= r) {
|
|
/* s is in the range */
|
|
COPY_SHORT(&offset, l + L_ADDR);
|
|
if (!offset) {
|
|
/* range with lookup table */
|
|
l = pc + offset + (s - r) * sizeof(short);
|
|
COPY_SHORT(&offset, l);
|
|
} /* else normal range and offset is correct */
|
|
break;
|
|
}
|
|
}
|
|
/* use default address */
|
|
COPY_SHORT(&offset, pc + SW_DEFAULT);
|
|
break;
|
|
} else { /* d >= SWITCH_CASE_SIZE */
|
|
l += d;
|
|
/* if table isn't a power of 2 in size, fix us up */
|
|
while (l >= end_tab) {
|
|
d >>= 1;
|
|
if (d < SWITCH_CASE_SIZE) {
|
|
d = 0;
|
|
break;
|
|
}
|
|
l -= d;
|
|
}
|
|
if (l == end_tab) {
|
|
/* use default address */
|
|
COPY_SHORT(&offset, pc + SW_DEFAULT);
|
|
break;
|
|
}
|
|
d >>= 1;
|
|
}
|
|
} else {
|
|
/* s == r */
|
|
COPY_SHORT(&offset, l + U_ADDR);
|
|
/* found the key - but could be part of a range... */
|
|
if (!l[U_TYPE] && !l[U_TYPE + 1]) {
|
|
/* end of range with lookup table */
|
|
COPY_PTR(&r, l + U_LOWER);
|
|
l = pc + offset + (s - r) * sizeof(short);
|
|
COPY_SHORT(&offset, l);
|
|
}
|
|
if (offset <= 1) {
|
|
COPY_SHORT(&offset, l + L_ADDR);
|
|
if (!offset) {
|
|
/* start of range with lookup table */
|
|
l = pc + offset;
|
|
COPY_SHORT(&offset, l);
|
|
} /* else normal range, offset is correct */
|
|
}
|
|
break;
|
|
}
|
|
}
|
|
/* now do jump */
|
|
pc += offset;
|
|
}
|
|
|
|
void
|
|
call_simul_efun (unsigned short index, int num_arg)
|
|
{
|
|
extern object_t *simul_efun_ob;
|
|
|
|
if (current_object->flags & O_DESTRUCTED) { /* No external calls allowed */
|
|
pop_n_elems(num_arg);
|
|
push_undefined();
|
|
return;
|
|
}
|
|
|
|
if (simuls[index].func) {
|
|
#ifdef TRACE
|
|
if (TRACEP(TRACE_CALL_OTHER)) {
|
|
do_trace("simul_efun ", simuls[index].func->funcname, "\n");
|
|
}
|
|
#endif
|
|
/* Don't need to use apply() since we have the pointer directly;
|
|
* this saves function lookup.
|
|
*/
|
|
call_direct(simul_efun_ob, simuls[index].index,
|
|
ORIGIN_SIMUL_EFUN, num_arg);
|
|
} else
|
|
error("Function is no longer a simul_efun.\n");
|
|
}
|
|
|
|
INLINE void
|
|
f_xor()
|
|
{
|
|
CHECK_TYPES((sp - 1), T_NUMBER, 1, F_XOR);
|
|
CHECK_TYPES(sp, T_NUMBER, 2, F_XOR);
|
|
sp--;
|
|
sp->u.number ^= (sp + 1)->u.number;
|
|
}
|
|
|
|
INLINE void
|
|
f_xor_eq()
|
|
{
|
|
svalue_t *argp;
|
|
|
|
if ((argp = sp->u.lvalue)->type != T_NUMBER)
|
|
error("Bad left type to ^=\n");
|
|
if ((--sp)->type != T_NUMBER)
|
|
error("Bad right type to ^=\n");
|
|
sp->u.number = argp->u.number ^= sp->u.number;
|
|
}
|
|
|
|
INLINE void
|
|
f_function_constructor()
|
|
{
|
|
funptr_t *fp;
|
|
int kind;
|
|
unsigned short index;
|
|
|
|
kind = EXTRACT_UCHAR(pc++);
|
|
|
|
switch (kind) {
|
|
case FP_EFUN:
|
|
LOAD_SHORT(index, pc);
|
|
fp = make_efun_funp(index, sp);
|
|
pop_stack();
|
|
break;
|
|
case FP_LOCAL:
|
|
LOAD_SHORT(index, pc);
|
|
fp = make_lfun_funp(index, sp);
|
|
pop_stack();
|
|
break;
|
|
case FP_SIMUL:
|
|
LOAD_SHORT(index, pc);
|
|
fp = make_simul_funp(index, sp);
|
|
pop_stack();
|
|
break;
|
|
case FP_FUNCTIONAL:
|
|
case FP_FUNCTIONAL | FP_NOT_BINDABLE:
|
|
{
|
|
int num_arg;
|
|
|
|
num_arg = EXTRACT_UCHAR(pc++); /* number of arguments */
|
|
LOAD_SHORT(index, pc); /* length of functional */
|
|
fp = make_functional_funp(num_arg, 0, index, sp, kind & FP_NOT_BINDABLE);
|
|
pop_stack();
|
|
break;
|
|
}
|
|
case FP_ANONYMOUS:
|
|
case FP_ANONYMOUS | FP_NOT_BINDABLE:
|
|
{
|
|
int num_arg, locals;
|
|
|
|
num_arg = EXTRACT_UCHAR(pc++);
|
|
locals = EXTRACT_UCHAR(pc++);
|
|
LOAD_SHORT(index, pc); /* length */
|
|
fp = make_functional_funp(num_arg, locals, index, 0, kind & FP_NOT_BINDABLE);
|
|
break;
|
|
}
|
|
default:
|
|
fatal("Tried to make unknown type of function pointer.\n");
|
|
}
|
|
push_refed_funp(fp);
|
|
}
|
|
|
|
INLINE void
|
|
f__evaluate (void)
|
|
{
|
|
svalue_t *v;
|
|
svalue_t *arg = sp - st_num_arg + 1;
|
|
|
|
if (arg->type != T_FUNCTION) {
|
|
pop_n_elems(st_num_arg-1);
|
|
return;
|
|
}
|
|
if (current_object->flags & O_DESTRUCTED) {
|
|
pop_n_elems(st_num_arg);
|
|
push_undefined();
|
|
return;
|
|
}
|
|
v = call_function_pointer(arg->u.fp, st_num_arg - 1);
|
|
assign_svalue(sp, v);
|
|
}
|
|
|
|
INLINE void
|
|
f_sscanf()
|
|
{
|
|
svalue_t *fp;
|
|
int i;
|
|
int num_arg;
|
|
|
|
/*
|
|
* get number of lvalue args
|
|
*/
|
|
num_arg = EXTRACT_UCHAR(pc);
|
|
pc++;
|
|
|
|
/*
|
|
* allocate stack frame for rvalues and return value (number of matches);
|
|
* perform some stack manipulation; note: source and template strings are
|
|
* already on the stack by this time
|
|
*/
|
|
fp = sp;
|
|
CHECK_STACK_OVERFLOW(num_arg + 1);
|
|
sp += num_arg + 1;
|
|
*sp = *(fp--); /* move format description to top of stack */
|
|
*(sp - 1) = *(fp); /* move source string just below the format
|
|
* desc. */
|
|
fp->type = T_NUMBER; /* this svalue isn't invalidated below, and
|
|
* if we don't change it to something safe,
|
|
* it will get freed twice if an error occurs */
|
|
/*
|
|
* prep area for rvalues
|
|
*/
|
|
for (i = 1; i <= num_arg; i++)
|
|
fp[i].type = T_INVALID;
|
|
|
|
/*
|
|
* do it...
|
|
*/
|
|
i = inter_sscanf(sp - 2, sp - 1, sp, num_arg);
|
|
|
|
/*
|
|
* remove source & template strings from top of stack
|
|
*/
|
|
pop_2_elems();
|
|
|
|
/*
|
|
* save number of matches on stack
|
|
*/
|
|
fp->u.number = i;
|
|
fp->subtype = 0;
|
|
}
|