void c_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 - 1)->u.string, sp->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);
}
}
}
static T get_NaN()
{
::std::string error_reporting("Argument to atanh is strictly greater than +1 or strictly smaller than -1!");
::std::domain_error bad_argument(error_reporting);
throw(bad_argument);
}
static T get_neg_infinity()
{
::std::string error_reporting("Argument to atanh is -1 (result: -Infinity)!");
::std::out_of_range bad_argument(error_reporting);
throw(bad_argument);
}
void c_multiply() {
switch((sp-1)->type|sp->type) {
case T_NUMBER:
{
sp--;
sp->u.number *= (sp+1)->u.number;
break;
}
case T_REAL:
{
sp--;
sp->u.real *= (sp+1)->u.real;
break;
}
case T_NUMBER|T_REAL:
{
if ((--sp)->type == T_NUMBER) {
sp->type = T_REAL;
sp->u.real = sp->u.number * (sp+1)->u.real;
}
else sp->u.real *= (sp+1)->u.number;
break;
}
case T_MAPPING:
{
mapping_t *m;
m = compose_mapping((sp-1)->u.map, sp->u.map, 1);
pop_2_elems();
push_refed_mapping(m);
break;
}
default:
{
if (!((sp-1)->type & (T_NUMBER|T_REAL|T_MAPPING)))
bad_argument(sp-1, T_NUMBER|T_REAL|T_MAPPING,1, F_MULTIPLY);
if (!(sp->type & (T_NUMBER|T_REAL|T_MAPPING)))
bad_argument(sp, T_NUMBER|T_REAL|T_MAPPING,2, F_MULTIPLY);
error("Args to * are not compatible.\n");
}
}
}
void call(const std::string& query, std::ostream& cout)
{
args a;
if (!std::regex_match(query, a.args, m_regex))
throw bad_argument();
a.prefix = prefix;
a.query = query;
(m_object->*m_member)(a, cout);
}
int open_asm(int ac, char **av)
{
int fd;
if (ac < 2 || ac > 2)
bad_argument();
if ((fd = open_file(av[1])) == -1)
open_fail();
return (fd);
}
void c_divide() {
switch((sp-1)->type|sp->type) {
case T_NUMBER:
{
if (!(sp--)->u.number) error("Division by zero\n");
sp->u.number /= (sp+1)->u.number;
break;
}
case T_REAL:
{
if ((sp--)->u.real == 0.0) error("Division by zero\n");
sp->u.real /= (sp+1)->u.real;
break;
}
case T_NUMBER|T_REAL:
{
if ((sp--)->type == T_NUMBER) {
if (!((sp+1)->u.number)) error("Division by zero\n");
sp->u.real /= (sp+1)->u.number;
} else {
if ((sp+1)->u.real == 0.0) error("Division by 0.0\n");
sp->type = T_REAL;
sp->u.real = sp->u.number / (sp+1)->u.real;
}
break;
}
default:
{
if (!((sp-1)->type & (T_NUMBER|T_REAL)))
bad_argument(sp-1,T_NUMBER|T_REAL,1, F_DIVIDE);
if (!(sp->type & (T_NUMBER|T_REAL)))
bad_argument(sp, T_NUMBER|T_REAL,2, F_DIVIDE);
}
}
}
void c_ge() {
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_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);
}
}
}
}
T same_impl_ex (const T &size1, const T &size2, const char *file, int line) {
BOOST_UBLAS_CHECK_EX (size1 == size2, file, line, bad_argument ());
return (std::min) (size1, size2);
}
T1 same_impl_ex (const T1 &size1, const T2 &size2, const char *file, int line) {
BOOST_UBLAS_CHECK_EX (size1 == size2, file, line, bad_argument ());
return (size1 < size2)?(size1):(size2);
}
void c_add_eq(int is_void) {
DEBUG_CHECK(sp->type != T_LVALUE,
"non-lvalue argument to +=\n");
lval = sp->u.lvalue;
sp--; /* points to the RHS */
switch (lval->type) {
case T_STRING:
if (sp->type == T_STRING) {
SVALUE_STRING_JOIN(lval, sp, "f_add_eq: 1");
} else if (sp->type == T_NUMBER) {
char buff[20];
sprintf(buff, "%d", sp->u.number);
EXTEND_SVALUE_STRING(lval, buff, "f_add_eq: 2");
} else if (sp->type == T_REAL) {
char buff[40];
sprintf(buff, "%f", sp->u.real);
EXTEND_SVALUE_STRING(lval, buff, "f_add_eq: 2");
} else {
bad_argument(sp, T_STRING | T_NUMBER | T_REAL, 2,
(is_void ? F_VOID_ADD_EQ : F_ADD_EQ));
}
break;
case T_NUMBER:
if (sp->type == T_NUMBER) {
lval->u.number += sp->u.number;
/* both sides are numbers, no freeing required */
} else if (sp->type == T_REAL) {
lval->u.number += sp->u.real;
/* both sides are numbers, no freeing required */
} else {
error("Left hand side of += is a number (or zero); right side is not a number.\n");
}
break;
case T_REAL:
if (sp->type == T_NUMBER) {
lval->u.real += sp->u.number;
/* both sides are numerics, no freeing required */
}
if (sp->type == T_REAL) {
lval->u.real += sp->u.real;
/* both sides are numerics, no freeing required */
} else {
error("Left hand side of += is a number (or zero); right side is not a number.\n");
}
break;
#ifndef NO_BUFFER_TYPE
case T_BUFFER:
if (sp->type != T_BUFFER) {
bad_argument(sp, T_BUFFER, 2, (is_void ? F_VOID_ADD_EQ : F_ADD_EQ));
} else {
buffer_t *b;
b = allocate_buffer(lval->u.buf->size + sp->u.buf->size);
memcpy(b->item, lval->u.buf->item, lval->u.buf->size);
memcpy(b->item + lval->u.buf->size, sp->u.buf->item,
sp->u.buf->size);
free_buffer(sp->u.buf);
free_buffer(lval->u.buf);
lval->u.buf = b;
}
break;
#endif
case T_ARRAY:
if (sp->type != T_ARRAY)
bad_argument(sp, T_ARRAY, 2, (is_void ? F_VOID_ADD_EQ : F_ADD_EQ));
else {
/* add_array now frees the arrays */
lval->u.arr = add_array(lval->u.arr, sp->u.arr);
}
break;
case T_MAPPING:
if (sp->type != T_MAPPING)
bad_argument(sp, T_MAPPING, 2, (is_void ? F_VOID_ADD_EQ : F_ADD_EQ));
else {
absorb_mapping(lval->u.map, sp->u.map);
free_mapping(sp->u.map); /* free RHS */
/* LHS not freed because its being reused */
}
break;
case T_LVALUE_BYTE:
if (sp->type != T_NUMBER)
error("Bad right type to += of char lvalue.\n");
else *global_lvalue_byte.u.lvalue_byte += sp->u.number;
break;
default:
bad_arg(1, (is_void ? F_VOID_ADD_EQ : F_ADD_EQ));
}
if (!is_void) { /* not void add_eq */
assign_svalue_no_free(sp, lval);
} else {
/*
* but if (void)add_eq then no need to produce an
* rvalue
*/
sp--;
}
}
void
filter_array P2(svalue_t *, arg, int, num_arg)
{
array_t *vec = arg->u.arr, *r;
int size;
if ((size = vec->size) < 1) {
pop_n_elems(num_arg - 1);
return;
}
else {
funptr_t *fp;
object_t *ob = 0;
char *func;
char *flags = new_string(size, "TEMP: filter: flags");
svalue_t *extra, *v;
int res = 0, cnt, numex = 0;
push_malloced_string(flags);
if ((arg+1)->type == T_FUNCTION){
fp = (arg+1)->u.fp;
if (num_arg > 2) extra = arg+2, numex = num_arg - 2;
} else {
func = (arg+1)->u.string;
if (num_arg < 3) ob = current_object;
else {
if ((arg+2)->type == T_OBJECT) ob = (arg+2)->u.ob;
else if ((arg+2)->type == T_STRING){
if ((ob = find_object(arg[2].u.string)) && !object_visible(ob)) ob = 0;
}
if (!ob) bad_argument(arg+2, T_STRING | T_OBJECT, 3, F_FILTER);
if (num_arg > 3) extra = arg + 3, numex = num_arg - 3;
}
}
for (cnt = 0; cnt < size; cnt++){
push_svalue(vec->item + cnt);
if (numex) push_some_svalues(extra, numex);
v = ob ? apply(func, ob, 1 + numex, ORIGIN_EFUN)
: call_function_pointer(fp, 1 + numex);
if (!IS_ZERO(v)){
flags[cnt] = 1;
res++;
} else flags[cnt] = 0;
}
r = allocate_empty_array(res);
if (res){
while (cnt--) {
if (flags[cnt])
assign_svalue_no_free(&r->item[--res], vec->item+cnt);
}
}
FREE_MSTR(flags);
sp--;
pop_n_elems(num_arg - 1);
free_array(vec);
sp->u.arr = r;
}
}
