Select Git revision
operators.c 125.75 KiB
/*
|| This file is part of Pike. For copyright information see COPYRIGHT.
|| Pike is distributed under GPL, LGPL and MPL. See the file COPYING
|| for more information.
|| $Id: operators.c,v 1.186 2003/12/16 23:08:00 grendel Exp $
*/
#include "global.h"
#include <math.h>
RCSID("$Id: operators.c,v 1.186 2003/12/16 23:08:00 grendel Exp $");
#include "interpret.h"
#include "svalue.h"
#include "multiset.h"
#include "mapping.h"
#include "array.h"
#include "stralloc.h"
#include "opcodes.h"
#include "operators.h"
#include "language.h"
#include "pike_memory.h"
#include "pike_error.h"
#include "docode.h"
#include "constants.h"
#include "peep.h"
#include "lex.h"
#include "program.h"
#include "object.h"
#include "pike_types.h"
#include "module_support.h"
#include "pike_macros.h"
#include "bignum.h"
#include "builtin_functions.h"
#include "cyclic.h"
#include "security.h"
#define sp Pike_sp
#define OP_DIVISION_BY_ZERO_ERROR(FUNC) \
math_error(FUNC, sp-2, 2, 0, "Division by zero.\n")
#define OP_MODULO_BY_ZERO_ERROR(FUNC) \
math_error(FUNC, sp-2, 2, 0, "Modulo by zero.\n")
void index_no_free(struct svalue *to,struct svalue *what,struct svalue *ind)
{
#ifdef PIKE_SECURITY
if(what->type <= MAX_COMPLEX)
if(!CHECK_DATA_SECURITY(what->u.array, SECURITY_BIT_INDEX))
Pike_error("Index permission denied.\n");
#endif
switch(what->type)
{
case T_ARRAY:
simple_array_index_no_free(to,what->u.array,ind);
break;
case T_MAPPING:
mapping_index_no_free(to,what->u.mapping,ind);
break;
case T_OBJECT:
object_index_no_free(to, what->u.object, ind);
break;
case T_MULTISET: {
int i=multiset_member(what->u.multiset, ind);
to->type=T_INT;
to->subtype=i ? 0 : NUMBER_UNDEFINED;
to->u.integer=i;
break; }
case T_STRING:
if(ind->type==T_INT)
{
ptrdiff_t len = what->u.string->len;
INT_TYPE p = ind->u.integer;
INT_TYPE i = p < 0 ? p + len : p;
if(i<0 || i>=len)
{
if(len == 0)
Pike_error("Attempt to index the empty string with %"PRINTPIKEINT"d.\n", i);
else
Pike_error("Index %"PRINTPIKEINT"d is out of string range "
"%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n",
i, -len, len - 1);
} else
i=index_shared_string(what->u.string,i);
to->type=T_INT;
to->subtype=NUMBER_NUMBER;
to->u.integer=i;
break;
}else{
if (ind->type == T_STRING && !ind->u.string->size_shift)
Pike_error ("Expected integer as string index, got \"%s\".\n",
ind->u.string->str);
else
Pike_error ("Expected integer as string index, got %s.\n",
get_name_of_type (ind->type));
}
case T_PROGRAM:
program_index_no_free(to, what->u.program, ind);
break;
case T_FUNCTION:
{
struct program *p = program_from_svalue(what);
if (p) {
program_index_no_free(to, p, ind);
break;
}
}
/* FALL THROUGH */
#ifdef AUTO_BIGNUM
case T_INT:
if (ind->type == T_STRING) {
INT_TYPE val = what->u.integer;
convert_svalue_to_bignum(what);
index_no_free(to, what, ind);
if(IS_UNDEFINED(to)) {
if (val) {
if (!ind->u.string->size_shift)
Pike_error("Indexing the integer %"PRINTPIKEINT"d "
"with unknown method \"%s\".\n",
val, ind->u.string->str);
else
Pike_error("Indexing the integer %"PRINTPIKEINT"d "
"with a wide string.\n",
val);
} else {
if(!ind->u.string->size_shift)
Pike_error("Indexing the NULL value with \"%s\".\n",
ind->u.string->str);
else
Pike_error("Indexing the NULL value with a wide string.\n");
}
} break;
}
/* FALL_THROUGH */
#endif /* AUTO_BIGNUM */
default:
if (ind->type == T_INT)
Pike_error ("Cannot index %s with %"PRINTPIKEINT"d.\n",
(what->type == T_INT && !what->u.integer)?
"the NULL value":get_name_of_type(what->type),
ind->u.integer);
else if (ind->type == T_FLOAT)
Pike_error ("Cannot index %s with %"PRINTPIKEFLOAT"g.\n",
(what->type == T_INT && !what->u.integer)?
"the NULL value":get_name_of_type(what->type),
ind->u.float_number);
else if (ind->type == T_STRING && !ind->u.string->size_shift)
Pike_error ("Cannot index %s with \"%s\".\n",
(what->type == T_INT && !what->u.integer)?
"the NULL value":get_name_of_type(what->type),
ind->u.string->str);
else
Pike_error ("Cannot index %s with %s.\n",
(what->type == T_INT && !what->u.integer)?
"the NULL value":get_name_of_type(what->type),
get_name_of_type (ind->type));
}
}
void o_index(void)
{
struct svalue s;
index_no_free(&s,sp-2,sp-1);
pop_n_elems(2);
*sp=s;
dmalloc_touch_svalue(sp);
sp++;
dmalloc_touch_svalue(Pike_sp-1);
}
/*! @class MasterObject
*/
/*! @decl object cast_to_object(string str, string|void current_file)
*!
*! Called by the Pike runtime to cast strings to objects.
*!
*! @param str
*! String to cast to object.
*!
*! @param current_file
*! Filename of the file that attempts to perform the cast.
*!
*! @returns
*! Returns the resulting object.
*!
*! @seealso
*! @[cast_to_program()]
*/
/*! @decl program cast_to_program(string str, string|void current_file)
*!
*! Called by the Pike runtime to cast strings to programs.
*!
*! @param str
*! String to cast to object.
*!
*! @param current_file
*! Filename of the file that attempts to perform the cast. *!
*! @returns
*! Returns the resulting program.
*!
*! @seealso
*! @[cast_to_object()]
*/
/*! @endclass
*/
/* Special case for casting to int. */
void o_cast_to_int(void)
{
switch(sp[-1].type)
{
case T_OBJECT:
{
struct pike_string *s;
REF_MAKE_CONST_STRING(s, "int");
push_string(s);
if(!sp[-2].u.object->prog)
Pike_error("Cast called on destructed object.\n");
if(FIND_LFUN(sp[-2].u.object->prog,LFUN_CAST) == -1)
Pike_error("No cast method in object.\n");
apply_lfun(sp[-2].u.object, LFUN_CAST, 1);
free_svalue(sp-2);
sp[-2]=sp[-1];
sp--;
dmalloc_touch_svalue(sp);
}
if(sp[-1].type != PIKE_T_INT)
{
if(sp[-1].type == T_OBJECT && sp[-1].u.object->prog)
{
int f=FIND_LFUN(sp[-1].u.object->prog, LFUN__IS_TYPE);
if( f != -1)
{
struct pike_string *s;
REF_MAKE_CONST_STRING(s, "int");
push_string(s);
apply_low(sp[-2].u.object, f, 1);
f=!UNSAFE_IS_ZERO(sp-1);
pop_stack();
if(f) return;
}
}
Pike_error("Cast failed, wanted int, got %s\n",
get_name_of_type(sp[-1].type));
}
break;
case T_FLOAT:
{
int i=DO_NOT_WARN((int)(sp[-1].u.float_number));
#ifdef AUTO_BIGNUM
if((i < 0 ? -i : i) < floor(fabs(sp[-1].u.float_number)))
{
/* Note: This includes the case when i = 0x80000000, i.e.
the absolute value is not computable. */
convert_stack_top_to_bignum();
return; /* FIXME: OK to return? Cast tests below indicates
we have to do this, at least for now... /Noring */
/* Yes, it is ok to return, it is actually an optimization :)
* /Hubbe
*/
}
else
#endif /* AUTO_BIGNUM */
{ sp[-1].type=T_INT;
sp[-1].u.integer=i;
}
}
break;
case T_STRING:
/* This can be here independently of AUTO_BIGNUM. Besides,
we really want to reduce the number of number parsers
around here. :) /Noring */
#ifdef AUTO_BIGNUM
/* The generic function is rather slow, so I added this
* code for benchmark purposes. :-) /per
*/
if( sp[-1].u.string->len < 10 &&
!sp[-1].u.string->size_shift )
{
int i=atoi(sp[-1].u.string->str);
free_string(sp[-1].u.string);
sp[-1].type=T_INT;
sp[-1].u.integer=i;
}
else
convert_stack_top_string_to_inumber(10);
return; /* FIXME: OK to return? Cast tests below indicates
we have to do this, at least for now... /Noring */
/* Yes, it is ok to return, it is actually an optimization :)
* /Hubbe
*/
#else
{
int i=STRTOL(sp[-1].u.string->str,0,10);
free_string(sp[-1].u.string);
sp[-1].type=T_INT;
sp[-1].u.integer=i;
}
#endif /* AUTO_BIGNUM */
break;
case PIKE_T_INT:
break;
default:
Pike_error("Cannot cast %s to int.\n", get_name_of_type(sp[-1].type));
}
}
/* Special case for casting to string. */
void o_cast_to_string(void)
{
char buf[200];
switch(sp[-1].type)
{
case PIKE_T_STRING:
return;
case T_OBJECT:
{
struct pike_string *s;
REF_MAKE_CONST_STRING(s, "string");
push_string(s);
if(!sp[-2].u.object->prog)
Pike_error("Cast called on destructed object.\n");
if(FIND_LFUN(sp[-2].u.object->prog,LFUN_CAST) == -1)
Pike_error("No cast method in object.\n");
apply_lfun(sp[-2].u.object, LFUN_CAST, 1);
free_svalue(sp-2);
sp[-2]=sp[-1];
sp--; dmalloc_touch_svalue(sp);
}
if(sp[-1].type != PIKE_T_STRING)
{
if(sp[-1].type == T_OBJECT && sp[-1].u.object->prog)
{
int f=FIND_LFUN(sp[-1].u.object->prog, LFUN__IS_TYPE);
if( f != -1)
{
struct pike_string *s;
REF_MAKE_CONST_STRING(s, "string");
push_string(s);
apply_low(sp[-2].u.object, f, 1);
f=!UNSAFE_IS_ZERO(sp-1);
pop_stack();
if(f) return;
}
}
Pike_error("Cast failed, wanted string, got %s\n",
get_name_of_type(sp[-1].type));
}
return;
case T_ARRAY:
{
int i;
struct array *a = sp[-1].u.array;
struct pike_string *s;
int shift = 0;
for(i = a->size; i--; ) {
unsigned INT32 val;
if (a->item[i].type != T_INT) {
Pike_error("cast: Item %d is not an integer.\n", i);
}
val = (unsigned INT32)a->item[i].u.integer;
if (val > 0xff) {
shift = 1;
if (val > 0xffff) {
shift = 2;
while(i--)
if (a->item[i].type != T_INT)
Pike_error("cast: Item %d is not an integer.\n", i);
break;
}
while(i--) {
if (a->item[i].type != T_INT) {
Pike_error("cast: Item %d is not an integer.\n", i);
}
val = (unsigned INT32)a->item[i].u.integer;
if (val > 0xffff) {
shift = 2;
while(i--)
if (a->item[i].type != T_INT)
Pike_error("cast: Item %d is not an integer.\n", i);
break;
}
}
break;
}
}
s = begin_wide_shared_string(a->size, shift);
switch(shift) {
case 0:
for(i = a->size; i--; ) {
s->str[i] = a->item[i].u.integer;
}
break;
case 1:
{ p_wchar1 *str1 = STR1(s);
for(i = a->size; i--; ) {
str1[i] = a->item[i].u.integer;
}
}
break;
case 2:
{
p_wchar2 *str2 = STR2(s);
for(i = a->size; i--; ) {
str2[i] = a->item[i].u.integer;
}
}
break;
default:
free_string(end_shared_string(s));
Pike_fatal("cast: Bad shift: %d.\n", shift);
break;
}
s = end_shared_string(s);
pop_stack();
push_string(s);
}
return;
case T_INT:
sprintf(buf, "%"PRINTPIKEINT"d", sp[-1].u.integer);
break;
case T_FLOAT:
sprintf(buf, "%f", (double)sp[-1].u.float_number);
break;
default:
Pike_error("Cannot cast %s to string.\n", get_name_of_type(sp[-1].type));
}
sp[-1].type = PIKE_T_STRING;
sp[-1].u.string = make_shared_string(buf);
}
void o_cast(struct pike_type *type, INT32 run_time_type)
{
if(run_time_type != sp[-1].type)
{
if(run_time_type == T_MIXED)
return;
if(sp[-1].type == T_OBJECT)
{
struct pike_string *s;
s=describe_type(type);
push_string(s);
if(!sp[-2].u.object->prog)
Pike_error("Cast called on destructed object.\n");
if(FIND_LFUN(sp[-2].u.object->prog,LFUN_CAST) == -1)
Pike_error("No cast method in object.\n");
apply_lfun(sp[-2].u.object, LFUN_CAST, 1);
free_svalue(sp-2);
sp[-2]=sp[-1];
sp--;
dmalloc_touch_svalue(sp);
}else
switch(run_time_type)
{
default:
Pike_error("Cannot perform cast to that type.\n");
case T_MIXED: return;
case T_MULTISET:
switch(sp[-1].type)
{
case T_ARRAY:
{
extern void f_mkmultiset(INT32);
f_mkmultiset(1);
break;
}
default:
Pike_error("Cannot cast %s to multiset.\n",get_name_of_type(sp[-1].type));
}
break;
case T_MAPPING:
switch(sp[-1].type)
{
case T_ARRAY:
{
struct array *a=sp[-1].u.array;
struct array *b;
struct mapping *m;
INT32 i;
m=allocate_mapping(a->size); /* MAP_SLOTS(a->size) */
push_mapping(m);
for (i=0; i<a->size; i++)
{
if (ITEM(a)[i].type!=T_ARRAY)
Pike_error("Cast array to mapping: "
"element %d is not an array\n", i);
b=ITEM(a)[i].u.array;
if (b->size!=2)
Pike_error("Cast array to mapping: "
"element %d is not an array of size 2\n", i);
mapping_insert(m,ITEM(b)+0,ITEM(b)+1);
}
stack_swap();
pop_n_elems(1);
break;
}
default:
Pike_error("Cannot cast %s to mapping.\n",get_name_of_type(sp[-1].type));
}
break;
case T_ARRAY:
switch(sp[-1].type)
{
case T_MAPPING:
{
struct array *a=mapping_to_array(sp[-1].u.mapping);
pop_stack();
push_array(a);
break;
}
case T_STRING:
f_values(1);
break;
case T_MULTISET:
f_indices(1);
break;
default:
Pike_error("Cannot cast %s to array.\n",get_name_of_type(sp[-1].type));
}
break;
case T_INT:
o_cast_to_int();
return;
case T_STRING:
o_cast_to_string();
return;
case T_FLOAT:
{
FLOAT_TYPE f = 0.0;
switch(sp[-1].type)
{
case T_INT:
f=(FLOAT_TYPE)(sp[-1].u.integer);
break;
case T_STRING:
f =
(FLOAT_TYPE)STRTOD_PCHARP(MKPCHARP(sp[-1].u.string->str,
sp[-1].u.string->size_shift),
0);
free_string(sp[-1].u.string);
break;
default:
Pike_error("Cannot cast %s to float.\n",get_name_of_type(sp[-1].type));
}
sp[-1].type=T_FLOAT;
sp[-1].u.float_number=f;
break;
}
case T_OBJECT:
switch(sp[-1].type)
{
case T_STRING: {
struct pike_string *file;
INT32 lineno;
if(Pike_fp->pc &&
(file = low_get_line(Pike_fp->pc, Pike_fp->context.prog, &lineno))) {
push_string(file);
}else{
push_int(0);
}
/* FIXME: Ought to allow compile_handler to override.
*/
APPLY_MASTER("cast_to_object",2);
return;
}
case T_FUNCTION:
if (Pike_sp[-1].subtype == FUNCTION_BUILTIN) {
Pike_error("Cannot cast builtin functions to object.\n");
} else if (Pike_sp[-1].u.object->prog == pike_trampoline_program) {
ref_push_object(((struct pike_trampoline *)
(Pike_sp[-1].u.object->storage))->
frame->current_object);
stack_pop_keep_top();
} else {
Pike_sp[-1].type = T_OBJECT;
}
break;
default:
Pike_error("Cannot cast %s to object.\n",get_name_of_type(sp[-1].type));
}
break;
case T_PROGRAM:
switch(sp[-1].type)
{
case T_STRING: {
struct pike_string *file;
INT32 lineno;
if(Pike_fp->pc &&
(file = low_get_line(Pike_fp->pc, Pike_fp->context.prog, &lineno))) {
push_string(file);
}else{
push_int(0);
}
/* FIXME: Ought to allow compile_handler to override.
*/
APPLY_MASTER("cast_to_program",2);
return;
}
case T_FUNCTION:
{
struct program *p=program_from_function(sp-1);
if(p)
{
add_ref(p);
pop_stack();
push_program(p);
}else{
pop_stack();
push_int(0);
}
}
return;
default:
Pike_error("Cannot cast %s to a program.\n",get_name_of_type(sp[-1].type));
}
}
}
if(run_time_type != sp[-1].type)
{
if(sp[-1].type == T_OBJECT && sp[-1].u.object->prog)
{
int f=FIND_LFUN(sp[-1].u.object->prog, LFUN__IS_TYPE);
if( f != -1)
{
push_text(get_name_of_type(run_time_type));
apply_low(sp[-2].u.object, f, 1);
f=!UNSAFE_IS_ZERO(sp-1);
pop_stack();
if(f) goto emulated_type_ok;
}
}
Pike_error("Cast failed, wanted %s, got %s\n",
get_name_of_type(run_time_type),
get_name_of_type(sp[-1].type));
}
emulated_type_ok:
if (!type) return;
switch(run_time_type)
{
case T_ARRAY: {
struct pike_type *itype;
INT32 run_time_itype;
push_type_value(itype = index_type(type, int_type_string, 0));
run_time_itype = compile_type_to_runtime_type(itype);
if(run_time_itype != T_MIXED)
{
struct array *a;
struct array *tmp=sp[-2].u.array;
DECLARE_CYCLIC();
if((a=(struct array *)BEGIN_CYCLIC(tmp,0)))
{
ref_push_array(a);
}else{
INT32 e;
TYPE_FIELD types = 0;
#ifdef PIKE_DEBUG
struct svalue *save_sp=sp+1;
#endif
push_array(a=allocate_array(tmp->size));
SET_CYCLIC_RET(a);
for(e=0;e<a->size;e++)
{
push_svalue(tmp->item+e);
o_cast(itype, run_time_itype);
stack_pop_to_no_free (ITEM(a) + e);
types |= 1 << ITEM(a)[e].type;
}
a->type_field = types;
#ifdef PIKE_DEBUG
if(save_sp!=sp)
Pike_fatal("o_cast left stack droppings.\n");
#endif
}
END_CYCLIC();
assign_svalue(sp-3,sp-1);
pop_stack();
}
pop_stack();
}
break;
case T_MULTISET:
{
struct pike_type *itype;
INT32 run_time_itype;
push_type_value(itype = key_type(type, 0));
run_time_itype = compile_type_to_runtime_type(itype);
if(run_time_itype != T_MIXED)
{
struct multiset *m;
#ifdef PIKE_NEW_MULTISETS
struct multiset *tmp=sp[-2].u.multiset;
#else
struct array *tmp=sp[-2].u.multiset->ind;
#endif
DECLARE_CYCLIC();
if((m=(struct multiset *)BEGIN_CYCLIC(tmp,0)))
{
ref_push_multiset(m);
}else{
#ifdef PIKE_DEBUG
struct svalue *save_sp=sp+1;#endif
#ifdef PIKE_NEW_MULTISETS
ptrdiff_t nodepos;
if (multiset_indval (tmp))
Pike_error ("FIXME: Casting not implemented for multisets with values.\n");
push_multiset (m = allocate_multiset (multiset_sizeof (tmp),
multiset_get_flags (tmp),
multiset_get_cmp_less (tmp)));
SET_CYCLIC_RET(m);
if ((nodepos = multiset_first (tmp)) >= 0) {
ONERROR uwp;
SET_ONERROR (uwp, do_sub_msnode_ref, tmp);
do {
push_multiset_index (tmp, nodepos);
o_cast(itype, run_time_itype);
multiset_insert_2 (m, sp - 1, NULL, 0);
pop_stack();
} while ((nodepos = multiset_next (tmp, nodepos)) >= 0);
UNSET_ONERROR (uwp);
sub_msnode_ref (tmp);
}
#else /* PIKE_NEW_MULTISETS */
INT32 e;
struct array *a;
TYPE_FIELD types = 0;
push_multiset(m=allocate_multiset(a=allocate_array(tmp->size)));
SET_CYCLIC_RET(m);
for(e=0;e<a->size;e++)
{
push_svalue(tmp->item+e);
o_cast(itype, run_time_itype);
stack_pop_to_no_free (ITEM(a) + e);
types |= 1 << ITEM(a)[e].type;
}
a->type_field = types;
order_multiset(m);
#endif
#ifdef PIKE_DEBUG
if(save_sp!=sp)
Pike_fatal("o_cast left stack droppings.\n");
#endif
}
END_CYCLIC();
assign_svalue(sp-3,sp-1);
pop_stack();
}
pop_stack();
}
break;
case T_MAPPING:
{
struct pike_type *itype, *vtype;
INT32 run_time_itype;
INT32 run_time_vtype;
push_type_value(itype = key_type(type, 0));
run_time_itype = compile_type_to_runtime_type(itype);
push_type_value(vtype = index_type(type, mixed_type_string, 0));
run_time_vtype = compile_type_to_runtime_type(vtype);
if(run_time_itype != T_MIXED || run_time_vtype != T_MIXED)
{
struct mapping *m;
struct mapping *tmp=sp[-3].u.mapping;
DECLARE_CYCLIC();
if((m=(struct mapping *)BEGIN_CYCLIC(tmp,0)))
{
ref_push_mapping(m);
}else{
INT32 e;
struct keypair *k;
#ifdef PIKE_DEBUG
struct svalue *save_sp=sp+1;
#endif
push_mapping(m=allocate_mapping(m_sizeof(tmp)));
SET_CYCLIC_RET(m);
MAPPING_LOOP(tmp)
{
push_svalue(& k->ind);
o_cast(itype, run_time_itype);
push_svalue(& k->val);
o_cast(vtype, run_time_vtype);
mapping_insert(m,sp-2,sp-1);
pop_n_elems(2);
}
#ifdef PIKE_DEBUG
if(save_sp!=sp)
Pike_fatal("o_cast left stack droppings.\n");
#endif
}
END_CYCLIC();
assign_svalue(sp-4,sp-1);
pop_stack();
}
pop_n_elems(2);
}
}
}
PMOD_EXPORT void f_cast(void)
{
#ifdef PIKE_DEBUG
struct svalue *save_sp=sp;
if(sp[-2].type != T_TYPE)
Pike_fatal("Cast expression destroyed stack or left droppings! (Type:%d)\n",
sp[-2].type);
#endif
o_cast(sp[-2].u.type,
compile_type_to_runtime_type(sp[-2].u.type));
#ifdef PIKE_DEBUG
if(save_sp != sp)
Pike_fatal("Internal error: o_cast() left droppings on stack.\n");
#endif
free_svalue(sp-2);
sp[-2]=sp[-1];
sp--;
dmalloc_touch_svalue(sp);
}
#define COMPARISON(ID,NAME,FUN) \
PMOD_EXPORT void ID(INT32 args) \
{ \
int i; \
switch(args) \
{ \
case 0: case 1: \
SIMPLE_TOO_FEW_ARGS_ERROR(NAME, 2); \ case 2: \
i=FUN (sp-2,sp-1); \
pop_n_elems(2); \
push_int(i); \
break; \
default: \
for(i=1;i<args;i++) \
if(! ( FUN (sp-args+i-1, sp-args+i))) \
break; \
pop_n_elems(args); \
push_int(i==args); \
} \
}
/*! @decl int(0..1) `!=(mixed arg1, mixed arg2, mixed ... extras)
*!
*! Inequality test.
*!
*! Every expression with the @expr{!=@} operator becomes a call to
*! this function, i.e. @expr{a!=b@} is the same as
*! @expr{predef::`!=(a,b)@}.
*!
*! This is the inverse of @[`==()]; see that function for further
*! details.
*!
*! @returns
*! Returns @expr{1@} if the test is successful, @expr{0@}
*! otherwise.
*!
*! @seealso
*! @[`==()]
*/
PMOD_EXPORT void f_ne(INT32 args)
{
f_eq(args);
o_not();
}
/*! @decl int(0..1) `==(mixed arg1, mixed arg2, mixed ... extras)
*!
*! Equality test.
*!
*! Every expression with the @expr{==@} operator becomes a call to
*! this function, i.e. @expr{a==b@} is the same as
*! @expr{predef::`==(a,b)@}.
*!
*! If more than two arguments are given, each argument is compared
*! with the following one as described below, and the test is
*! successful iff all comparisons are successful.
*!
*! If the first argument is an object with an @[lfun::`==()], that
*! function is called with the second as argument, and the test is
*! successful iff its result is nonzero (according to @[`!]).
*!
*! Otherwise, if the second argument is an object with an
*! @[lfun::`==()], that function is called with the first as
*! argument, and the test is successful iff its result is nonzero
*! (according to @[`!]).
*!
*! Otherwise, if the arguments are of different types, the test is
*! unsuccessful. Function pointers to programs are automatically
*! converted to program pointers if necessary, though.
*!
*! Otherwise the test depends on the type of the arguments:
*! @mixed
*! @type int
*! Successful iff the two integers are numerically equal.
*! @type float
*! Successful iff the two floats are numerically equal or if *! both are NaN.
*! @type string
*! Successful iff the two strings are identical, character for
*! character. (Since all strings are kept unique, this is
*! actually a test whether the arguments point to the same
*! string, and it therefore run in constant time.)
*! @type array|mapping|multiset|object|function|program|type
*! Successful iff the two arguments point to the same instance.
*! @endmixed
*!
*! @returns
*! Returns @expr{1@} if the test is successful, @expr{0@}
*! otherwise.
*!
*! @note
*! Floats and integers are not automatically converted to test
*! against each other, so e.g. @expr{0==0.0@} is false.
*!
*! @note
*! Programs are not automatically converted to types to be compared
*! type-wise.
*!
*! @seealso
*! @[`!()], @[`!=()]
*/
COMPARISON(f_eq,"`==", is_eq)
/*! @decl int(0..1) `<(mixed arg1, mixed arg2, mixed ... extras)
*!
*! Less than test.
*!
*! Every expression with the @expr{<@} operator becomes a call to
*! this function, i.e. @expr{a<b@} is the same as
*! @expr{predef::`<(a,b)@}.
*!
*! @returns
*! Returns @expr{1@} if the test is successful, @expr{0@}
*! otherwise.
*!
*! @seealso
*! @[`<=()], @[`>()], @[`>=()]
*/
COMPARISON(f_lt,"`<" , is_lt)
/*! @decl int(0..1) `<=(mixed arg1, mixed arg2, mixed ... extras)
*!
*! Less than or equal test.
*!
*! Every expression with the @expr{<=@} operator becomes a call to
*! this function, i.e. @expr{a<=b@} is the same as
*! @expr{predef::`<=(a,b)@}.
*!
*! @returns
*! Returns @expr{1@} if the arguments are not strictly decreasing, and
*! @expr{0@} (zero) otherwise.
*!
*! This is the inverse of @[`>()].
*!
*! @seealso
*! @[`<()], @[`>()], @[`>=()]
*/
COMPARISON(f_le,"`<=",!is_gt)
/*! @decl int(0..1) `>(mixed arg1, mixed arg2, mixed ... extras)
*!
*! Greater than test.
*!
*! Every expression with the @expr{>@} operator becomes a call to
*! this function, i.e. @expr{a>b@} is the same as
*! @expr{predef::`>(a,b)@}. *!
*! @returns
*! Returns @expr{1@} if the arguments are strictly decreasing, and
*! @expr{0@} (zero) otherwise.
*!
*! @seealso
*! @[`<()], @[`<=()], @[`>=()]
*/
COMPARISON(f_gt,"`>" , is_gt)
/*! @decl int(0..1) `>=(mixed arg1, mixed arg2, mixed ... extras)
*!
*! Greater than or equal test.
*!
*! Every expression with the @expr{>=@} operator becomes a call to
*! this function, i.e. @expr{a>=b@} is the same as
*! @expr{predef::`>=(a,b)@}.
*!
*! @returns
*! Returns @expr{1@} if the arguments are not strictly increasing, and
*! @expr{0@} (zero) otherwise.
*!
*! This is the inverse of @[`<()].
*!
*! @seealso
*! @[`<=()], @[`>()], @[`<()]
*/
COMPARISON(f_ge,"`>=",!is_lt)
#define CALL_OPERATOR(OP, args) do { \
int i; \
if(!sp[-args].u.object->prog) \
bad_arg_error(lfun_names[OP], sp-args, args, 1, "object", sp-args, \
"Called in destructed object.\n"); \
if((i = FIND_LFUN(sp[-args].u.object->prog,OP)) == -1) \
bad_arg_error(lfun_names[OP], sp-args, args, 1, "object", sp-args, \
"Operator not in object.\n"); \
apply_low(sp[-args].u.object, i, args-1); \
free_svalue(sp-2); \
sp[-2]=sp[-1]; \
sp--; \
dmalloc_touch_svalue(sp); \
} while (0)
/*! @decl mixed `+(mixed arg)
*! @decl mixed `+(object arg, mixed ... more)
*! @decl int `+(int arg, int ... more)
*! @decl float `+(float|int arg, float|int ... more)
*! @decl string `+(string|float|int arg, string|float|int ... more)
*! @decl array `+(array arg, array ... more)
*! @decl mapping `+(mapping arg, mapping ... more)
*! @decl multiset `+(multiset arg, multiset ... more)
*!
*! Addition/concatenation.
*!
*! Every expression with the @expr{+@} operator becomes a call to
*! this function, i.e. @expr{a+b@} is the same as
*! @expr{predef::`+(a,b)@}. Longer @expr{+@} expressions are
*! normally optimized to one call, so e.g. @expr{a+b+c@} becomes
*! @expr{predef::`+(a,b,c)@}.
*!
*! @returns
*! If there's a single argument, that argument is returned.
*!
*! If @[arg] is an object with only one reference and an
*! @[lfun::`+=()], that function is called with the rest of the
*! arguments, and its result is returned.
*!
*! Otherwise, if @[arg] is an object with an @[lfun::`+()], that *! function is called with the rest of the arguments, and its
*! result is returned.
*!
*! Otherwise, if any of the other arguments is an object that has
*! an @[lfun::``+()], the first such function is called with the
*! arguments leading up to it, and @[`+()] is then called
*! recursively with the result and the rest of the arguments.
*!
*! Otherwise, if @[arg] is @[UNDEFINED] and the other arguments are
*! either arrays, mappings or multisets, the first argument is
*! ignored and the remaining are added together as described below.
*! This is useful primarily when appending to mapping values since
*! @expr{m[x] += ({foo})@} will work even if @expr{m[x]@} doesn't
*! exist yet.
*!
*! Otherwise the result depends on the argument types:
*! @mixed
*! @type int|float
*! The result is the sum of all the arguments. It's a float if
*! any argument is a float.
*! @type string|int|float
*! If any argument is a string, all will be converted to
*! strings and concatenated in order to form the result.
*! @type array
*! The array arguments are concatened in order to form the
*! result.
*! @type mapping
*! The result is like @[arg] but extended with the entries from
*! the other arguments. If the same index (according to
*! @[hash_value] and @[`==]) occur in several arguments, the
*! value from the last one is used.
*! @type multiset
*! The result is like @[arg] but extended with the entries from
*! the other arguments. Subsequences with orderwise equal
*! indices (i.e. where @[`<] returns false) are concatenated
*! into the result in argument order.
*! @endmixed
*! The function is not destructive on the arguments - the result is
*! always a new instance.
*!
*! @note
*! In Pike 7.0 and earlier the addition order was unspecified.
*!
*! The treatment of @[UNDEFINED] was new
*! in Pike 7.0.
*!
*! @seealso
*! @[`-()], @[lfun::`+()], @[lfun::``+()]
*/
PMOD_EXPORT void f_add(INT32 args)
{
INT_TYPE e,size;
TYPE_FIELD types;
types=0;
for(e=-args;e<0;e++) types|=1<<sp[e].type;
switch(types)
{
default:
if(!args)
{
SIMPLE_TOO_FEW_ARGS_ERROR("`+", 1);
}else{
if(types & BIT_OBJECT)
{
if (args == 1)
return;
if(sp[-args].type == T_OBJECT && sp[-args].u.object->prog) {
int i;
if(sp[-args].u.object->refs==1 &&
(i = FIND_LFUN(sp[-args].u.object->prog,LFUN_ADD_EQ)) != -1)
{
apply_low(sp[-args].u.object, i, args-1);
stack_pop_keep_top();
return;
}
if((i = FIND_LFUN(sp[-args].u.object->prog,LFUN_ADD)) != -1)
{
apply_low(sp[-args].u.object, i, args-1);
free_svalue(sp-2);
sp[-2]=sp[-1];
sp--;
dmalloc_touch_svalue(sp);
return;
}
}
for(e=1;e<args;e++)
{
int i;
if(sp[e-args].type == T_OBJECT &&
sp[e-args].u.object->prog &&
(i = FIND_LFUN(sp[e-args].u.object->prog,LFUN_RADD)) != -1)
{
struct svalue *tmp=sp+e-args;
check_stack(e);
assign_svalues_no_free(sp, sp-args, e, -1);
sp+=e;
apply_low(tmp->u.object, i, e);
if(args - e > 1)
{
assign_svalue(tmp, sp-1);
pop_stack();
f_add(args - e);
assign_svalue(sp-e-1,sp-1);
pop_n_elems(e);
}else{
assign_svalue(sp-args-1,sp-1);
pop_n_elems(args);
}
return;
}
}
}
}
switch(sp[-args].type)
{
case T_PROGRAM:
case T_FUNCTION:
SIMPLE_BAD_ARG_ERROR("`+", 1,
"string|object|int|float|array|mapping|multiset");
}
bad_arg_error("`+", sp-args, args, 1,
"string|object|int|float|array|mapping|multiset", sp-args,
"Incompatible types\n");
return; /* compiler hint */
case BIT_STRING:
{
struct pike_string *r;
PCHARP buf;
ptrdiff_t tmp;
int max_shift=0;
if(args==1) return;
size=0;
for(e=-args;e<0;e++)
{
size+=sp[e].u.string->len;
if(sp[e].u.string->size_shift > max_shift)
max_shift=sp[e].u.string->size_shift;
}
if(size == sp[-args].u.string->len)
{
pop_n_elems(args-1);
return;
}
tmp=sp[-args].u.string->len;
r=new_realloc_shared_string(sp[-args].u.string,size,max_shift);
sp[-args].type=T_INT;
buf=MKPCHARP_STR_OFF(r,tmp);
for(e=-args+1;e<0;e++)
{
pike_string_cpy(buf,sp[e].u.string);
INC_PCHARP(buf,sp[e].u.string->len);
}
sp[-args].u.string=low_end_shared_string(r);
sp[-args].type=T_STRING;
for(e=-args+1;e<0;e++) free_string(sp[e].u.string);
sp-=args-1;
break;
}
case BIT_STRING | BIT_INT:
case BIT_STRING | BIT_FLOAT:
case BIT_STRING | BIT_FLOAT | BIT_INT:
{
struct pike_string *r;
PCHARP buf;
char buffer[50];
int max_shift=0;
if ((sp[-args].type != T_STRING) && (sp[1-args].type != T_STRING)) {
struct svalue *save_sp = sp;
/* We need to perform a normal addition first.
*/
for (e=-args; e < 0; e++) {
if (save_sp[e].type == T_STRING)
break;
*(sp++) = save_sp[e];
dmalloc_touch_svalue(Pike_sp-1);
}
/* Perform the addition. */
f_add(args+e);
dmalloc_touch_svalue(Pike_sp-1);
save_sp[--e] = *(--sp);
#ifdef PIKE_DEBUG
if (sp != save_sp) {
Pike_fatal("f_add(): Lost track of stack %p != %p\n", sp, save_sp);
}
#endif /* PIKE_DEBUG */
/* Perform the rest of the addition. */
f_add(-e);
#ifdef PIKE_DEBUG
if (sp != save_sp + 1 + e) {
Pike_fatal("f_add(): Lost track of stack (2) %p != %p\n",
sp, save_sp + 1 + e);
}
#endif /* PIKE_DEBUG */
/* Adjust the stack. */
save_sp[-args] = sp[-1];
sp = save_sp + 1 - args; return;
} else {
e = -args;
}
size=0;
for(e=-args;e<0;e++)
{
switch(sp[e].type)
{
case T_STRING:
size+=sp[e].u.string->len;
if(sp[e].u.string->size_shift > max_shift)
max_shift=sp[e].u.string->size_shift;
break;
case T_INT:
size+=14;
break;
case T_FLOAT:
size+=22;
break;
}
}
r=begin_wide_shared_string(size,max_shift);
buf=MKPCHARP_STR(r);
size=0;
for(e=-args;e<0;e++)
{
switch(sp[e].type)
{
case T_STRING:
pike_string_cpy(buf,sp[e].u.string);
INC_PCHARP(buf,sp[e].u.string->len);
break;
case T_INT:
sprintf(buffer,"%"PRINTPIKEINT"d",sp[e].u.integer);
goto append_buffer;
case T_FLOAT:
sprintf(buffer,"%"PRINTPIKEFLOAT"f",sp[e].u.float_number);
append_buffer:
switch(max_shift)
{
case 0:
convert_0_to_0((p_wchar0 *)buf.ptr,buffer,strlen(buffer));
break;
case 1:
convert_0_to_1((p_wchar1 *)buf.ptr,(p_wchar0 *)buffer,
strlen(buffer));
break;
case 2:
convert_0_to_2((p_wchar2 *)buf.ptr,(p_wchar0 *)buffer,
strlen(buffer));
break;
}
INC_PCHARP(buf,strlen(buffer));
}
}
r = realloc_unlinked_string(r, SUBTRACT_PCHARP(buf, MKPCHARP_STR(r)));
r = low_end_shared_string(r);
pop_n_elems(args); push_string(r);
break;
}
case BIT_INT:
#ifdef AUTO_BIGNUM
size = 0;
for(e = -args; e < 0; e++)
{
if(INT_TYPE_ADD_OVERFLOW(sp[e].u.integer, size))
{
convert_svalue_to_bignum(sp-args);
f_add(args);
return;
}
else
{
size += sp[e].u.integer;
}
}
sp-=args;
push_int(size);
#else
size=0;
for(e=-args; e<0; e++) size+=sp[e].u.integer;
sp-=args-1;
sp[-1].u.integer=size;
#endif /* AUTO_BIGNUM */
break;
case BIT_FLOAT:
{
FLOAT_ARG_TYPE sum;
sum=0.0;
for(e=-args; e<0; e++) sum+=sp[e].u.float_number;
sp-=args-1;
sp[-1].u.float_number=sum;
break;
}
case BIT_FLOAT|BIT_INT:
{
FLOAT_ARG_TYPE sum;
sum=0.0;
for(e=-args; e<0; e++)
{
if(sp[e].type==T_FLOAT)
{
sum+=sp[e].u.float_number;
}else{
sum+=(FLOAT_ARG_TYPE)sp[e].u.integer;
}
}
sp-=args-1;
sp[-1].type=T_FLOAT;
sp[-1].u.float_number=sum;
break;
}
#define ADD_WITH_UNDEFINED(TYPE, T_TYPEID, ADD_FUNC, PUSH_FUNC) do { \
int e; \
if (sp[-args].type == T_INT) { \
if(IS_UNDEFINED(sp-args)) \
{ \
struct TYPE *x; \
\
for(e=1;e<args;e++) \
if(sp[e-args].type != T_TYPEID) \
SIMPLE_ARG_TYPE_ERROR("`+", e+1, #TYPE); \
\ x = ADD_FUNC(sp-args+1,args-1); \
pop_n_elems(args); \
PUSH_FUNC(x); \
return; \
} \
\
for(e=1;e<args;e++) \
if (sp[e-args].type != T_INT) \
SIMPLE_ARG_TYPE_ERROR("`+", e+1, "int"); \
} \
\
else { \
for(e=1;e<args;e++) \
if (sp[e-args].type != T_TYPEID) \
SIMPLE_ARG_TYPE_ERROR("`+", e+1, #TYPE); \
} \
\
DO_IF_DEBUG (Pike_fatal ("Shouldn't be reached.\n")); \
} while (0)
#define ADD(TYPE, ADD_FUNC, PUSH_FUNC) do { \
struct TYPE *x = ADD_FUNC (sp - args, args); \
pop_n_elems (args); \
PUSH_FUNC (x); \
return; \
} while (0)
case BIT_ARRAY|BIT_INT:
ADD_WITH_UNDEFINED (array, T_ARRAY, add_arrays, push_array);
case BIT_ARRAY:
ADD (array, add_arrays, push_array);
case BIT_MAPPING|BIT_INT:
ADD_WITH_UNDEFINED (mapping, T_MAPPING, add_mappings, push_mapping);
case BIT_MAPPING:
ADD (mapping, add_mappings, push_mapping);
case BIT_MULTISET|BIT_INT:
ADD_WITH_UNDEFINED (multiset, T_MULTISET, add_multisets, push_multiset);
case BIT_MULTISET:
ADD (multiset, add_multisets, push_multiset);
#undef ADD_WITH_UNDEFINED
#undef ADD
}
}
static int generate_sum(node *n)
{
node **first_arg, **second_arg;
switch(count_args(CDR(n)))
{
case 1:
do_docode(CDR(n),0);
return 1;
case 2:
first_arg=my_get_arg(&_CDR(n), 0);
second_arg=my_get_arg(&_CDR(n), 1);
do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
if(first_arg[0]->type == float_type_string &&
second_arg[0]->type == float_type_string)
{
emit0(F_ADD_FLOATS);
}
else if(first_arg[0]->type == int_type_string && second_arg[0]->type == int_type_string)
{
emit0(F_ADD_INTS);
}
else
{
emit0(F_ADD);
}
return 1;
default:
return 0;
}
}
static node *optimize_eq(node *n)
{
node **first_arg, **second_arg, *ret;
if(count_args(CDR(n))==2)
{
first_arg=my_get_arg(&_CDR(n), 0);
second_arg=my_get_arg(&_CDR(n), 1);
#ifdef PIKE_DEBUG
if(!first_arg || !second_arg)
Pike_fatal("Couldn't find argument!\n");
#endif
if(node_is_false(*first_arg) && !node_may_overload(*second_arg,LFUN_EQ))
{
ret=*second_arg;
ADD_NODE_REF(*second_arg);
return mkopernode("`!",ret,0);
}
if(node_is_false(*second_arg) && !node_may_overload(*first_arg,LFUN_EQ))
{
ret=*first_arg;
ADD_NODE_REF(*first_arg);
return mkopernode("`!",ret,0);
}
if (((*second_arg)->token == F_CONSTANT) &&
((*second_arg)->u.sval.type == T_STRING) &&
((*first_arg)->token == F_RANGE) &&
(CADR(*first_arg)->token == F_CONSTANT) &&
(CADR(*first_arg)->u.sval.type == T_INT) &&
(!(CADR(*first_arg)->u.sval.u.integer)) &&
(CDDR(*first_arg)->token == F_CONSTANT) &&
(CDDR(*first_arg)->u.sval.type == T_INT)) {
/* str[..c] == "foo" */
INT_TYPE c = CDDR(*first_arg)->u.sval.u.integer;
if ((*second_arg)->u.sval.u.string->len == c+1) {
/* str[..2] == "foo"
* ==>
* has_prefix(str, "foo");
*/
ADD_NODE_REF2(CAR(*first_arg),
ADD_NODE_REF2(*second_arg,
ret = mkopernode("has_prefix", CAR(*first_arg), *second_arg);
));
return ret;
} else if ((*second_arg)->u.sval.u.string->len <= c) {
/* str[..4] == "foo"
* ==>
* str == "foo"
*/
/* FIXME: Warn? */
ADD_NODE_REF2(CAR(*first_arg),
ADD_NODE_REF2(*second_arg, ret = mkopernode("`==", CAR(*first_arg), *second_arg);
));
return ret;
} else {
/* str[..1] == "foo"
* ==>
* (str, 0)
*/
/* FIXME: Warn? */
ADD_NODE_REF2(CAR(*first_arg),
ret = mknode(F_COMMA_EXPR, CAR(*first_arg), mkintnode(0));
);
return ret;
}
}
}
return 0;
}
static node *optimize_not(node *n)
{
node **first_arg, **more_args;
if(count_args(CDR(n))==1)
{
first_arg=my_get_arg(&_CDR(n), 0);
#ifdef PIKE_DEBUG
if(!first_arg)
Pike_fatal("Couldn't find argument!\n");
#endif
if(node_is_true(*first_arg)) return mkintnode(0);
if(node_is_false(*first_arg)) return mkintnode(1);
#define TMP_OPT(X,Y) do { \
if((more_args=is_call_to(*first_arg, X))) \
{ \
node *tmp=*more_args; \
if(count_args(*more_args) > 2) return 0; \
ADD_NODE_REF(*more_args); \
return mkopernode(Y,tmp,0); \
} } while(0)
TMP_OPT(f_eq, "`!=");
TMP_OPT(f_ne, "`==");
TMP_OPT(f_lt, "`>=");
TMP_OPT(f_gt, "`<=");
TMP_OPT(f_le, "`>");
TMP_OPT(f_ge, "`<");
#undef TMP_OPT
if((more_args = is_call_to(*first_arg, f_search)) &&
(count_args(*more_args) == 2)) {
node *search_args = *more_args;
if ((search_args->token == F_ARG_LIST) &&
CAR(search_args) &&
(CAR(search_args)->type == string_type_string) &&
CDR(search_args) &&
(CDR(search_args)->type == string_type_string)) {
/* !search(string a, string b) => has_prefix(a, b) */
ADD_NODE_REF(*more_args);
return mkefuncallnode("has_prefix", search_args);
}
}
}
return 0;
}
static node *may_have_side_effects(node *n)
{
node **arg; int argno;
for (argno = 0; (arg = my_get_arg(&_CDR(n), argno)); argno++) {
if (match_types(object_type_string, (*arg)->type)) {
n->node_info |= OPT_SIDE_EFFECT;
n->tree_info |= OPT_SIDE_EFFECT;
return NULL;
}
}
return NULL;
}
static node *optimize_binary(node *n)
{
node **first_arg, **second_arg, *ret;
if(count_args(CDR(n))==2)
{
first_arg=my_get_arg(&_CDR(n), 0);
second_arg=my_get_arg(&_CDR(n), 1);
#ifdef PIKE_DEBUG
if(!first_arg || !second_arg)
Pike_fatal("Couldn't find argument!\n");
#endif
if((*second_arg)->type == (*first_arg)->type &&
compile_type_to_runtime_type((*second_arg)->type) != T_MIXED)
{
if((*first_arg)->token == F_APPLY &&
CAR(*first_arg)->token == F_CONSTANT &&
is_eq(& CAR(*first_arg)->u.sval, & CAR(n)->u.sval))
{
ADD_NODE_REF2(CAR(n),
ADD_NODE_REF2(CDR(*first_arg),
ADD_NODE_REF2(*second_arg,
ret = mknode(F_APPLY,
CAR(n),
mknode(F_ARG_LIST,
CDR(*first_arg),
*second_arg))
)));
return ret;
}
if((*second_arg)->token == F_APPLY &&
CAR(*second_arg)->token == F_CONSTANT &&
is_eq(& CAR(*second_arg)->u.sval, & CAR(n)->u.sval))
{
ADD_NODE_REF2(CAR(n),
ADD_NODE_REF2(*first_arg,
ADD_NODE_REF2(CDR(*second_arg),
ret = mknode(F_APPLY,
CAR(n),
mknode(F_ARG_LIST,
*first_arg,
CDR(*second_arg)))
)));
return ret;
}
}
}
return 0;
}
static int generate_comparison(node *n)
{
if(count_args(CDR(n))==2)
{
if(do_docode(CDR(n),DO_NOT_COPY) != 2)
Pike_fatal("Count args was wrong in generate_comparison.\n");
if(CAR(n)->u.sval.u.efun->function == f_eq)
emit0(F_EQ);
else if(CAR(n)->u.sval.u.efun->function == f_ne)
emit0(F_NE);
else if(CAR(n)->u.sval.u.efun->function == f_lt)
emit0(F_LT);
else if(CAR(n)->u.sval.u.efun->function == f_le)
emit0(F_LE);
else if(CAR(n)->u.sval.u.efun->function == f_gt)
emit0(F_GT);
else if(CAR(n)->u.sval.u.efun->function == f_ge)
emit0(F_GE);
else
Pike_fatal("Couldn't generate comparison!\n");
return 1;
}
return 0;
}
static int float_promote(void)
{
if(sp[-2].type==T_INT && sp[-1].type==T_FLOAT)
{
sp[-2].u.float_number=(FLOAT_TYPE)sp[-2].u.integer;
sp[-2].type=T_FLOAT;
return 1;
}
else if(sp[-1].type==T_INT && sp[-2].type==T_FLOAT)
{
sp[-1].u.float_number=(FLOAT_TYPE)sp[-1].u.integer;
sp[-1].type=T_FLOAT;
return 1;
}
#ifdef AUTO_BIGNUM
if(is_bignum_object_in_svalue(sp-2) && sp[-1].type==T_FLOAT)
{
stack_swap();
ref_push_type_value(float_type_string);
stack_swap();
f_cast();
stack_swap();
return 1;
}
else if(is_bignum_object_in_svalue(sp-1) && sp[-2].type==T_FLOAT)
{
ref_push_type_value(float_type_string);
stack_swap();
f_cast();
return 1;
}
#endif
return 0;
}
static int call_lfun(int left, int right)
{
int i;
if(sp[-2].type == T_OBJECT &&
sp[-2].u.object->prog &&
(i = FIND_LFUN(sp[-2].u.object->prog,left)) != -1)
{
apply_low(sp[-2].u.object, i, 1);
free_svalue(sp-2);
sp[-2]=sp[-1];
sp--;
dmalloc_touch_svalue(sp);
return 1;
}
if(sp[-1].type == T_OBJECT &&
sp[-1].u.object->prog &&
(i = FIND_LFUN(sp[-1].u.object->prog,right)) != -1)
{
push_svalue(sp-2);
apply_low(sp[-2].u.object, i, 1);
free_svalue(sp-3);
sp[-3]=sp[-1];
sp--;
dmalloc_touch_svalue(sp);
pop_stack();
return 1;
}
return 0;
}
struct mapping *merge_mapping_array_ordered(struct mapping *a,
struct array *b, INT32 op);
struct mapping *merge_mapping_array_unordered(struct mapping *a,
struct array *b, INT32 op);
PMOD_EXPORT void o_subtract(void)
{
if (sp[-2].type != sp[-1].type && !float_promote())
{
if(call_lfun(LFUN_SUBTRACT, LFUN_RSUBTRACT))
return;
if (sp[-2].type==T_MAPPING)
switch (sp[-1].type)
{
case T_ARRAY:
{
struct mapping *m;
m=merge_mapping_array_unordered(sp[-2].u.mapping,
sp[-1].u.array,
PIKE_ARRAY_OP_SUB);
pop_n_elems(2);
push_mapping(m);
return;
}
case T_MULTISET:
{
struct mapping *m;
#ifdef PIKE_NEW_MULTISETS
int got_cmp_less = !!multiset_get_cmp_less (sp[-1].u.multiset);
struct array *ind = multiset_indices (sp[-1].u.multiset);
pop_stack();
push_array (ind);
if (got_cmp_less)
m=merge_mapping_array_unordered(sp[-2].u.mapping,
sp[-1].u.array,
PIKE_ARRAY_OP_SUB);
else
m=merge_mapping_array_ordered(sp[-2].u.mapping,
sp[-1].u.array,
PIKE_ARRAY_OP_SUB);
#else
m=merge_mapping_array_ordered(sp[-2].u.mapping,
sp[-1].u.multiset->ind,
PIKE_ARRAY_OP_SUB);
#endif
pop_n_elems(2);
push_mapping(m);
return; }
}
bad_arg_error("`-", sp-2, 2, 2, get_name_of_type(sp[-2].type),
sp-1, "Subtract on different types.\n");
}
switch(sp[-2].type)
{
case T_OBJECT:
CALL_OPERATOR(LFUN_SUBTRACT,2);
break;
case T_ARRAY:
{
struct array *a;
check_array_for_destruct(sp[-2].u.array);
check_array_for_destruct(sp[-1].u.array);
a = subtract_arrays(sp[-2].u.array, sp[-1].u.array);
pop_n_elems(2);
push_array(a);
return;
}
case T_MAPPING:
{
struct mapping *m;
m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping,PIKE_ARRAY_OP_SUB);
pop_n_elems(2);
push_mapping(m);
return;
}
case T_MULTISET:
{
struct multiset *l;
l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_SUB);
pop_n_elems(2);
push_multiset(l);
return;
}
case T_FLOAT:
sp--;
sp[-1].u.float_number -= sp[0].u.float_number;
return;
case T_INT:
#ifdef AUTO_BIGNUM
if(INT_TYPE_SUB_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer))
{
convert_stack_top_to_bignum();
f_minus(2);
return;
}
#endif /* AUTO_BIGNUM */
sp--;
sp[-1].u.integer -= sp[0].u.integer;
return;
case T_STRING:
{
struct pike_string *s,*ret;
s=make_shared_string("");
ret=string_replace(sp[-2].u.string,sp[-1].u.string,s);
free_string(sp[-2].u.string);
free_string(sp[-1].u.string);
free_string(s);
sp[-2].u.string=ret; sp--;
return;
}
/* FIXME: Support types? */
default:
{
int args = 2;
SIMPLE_BAD_ARG_ERROR("`-", 1,
"int|float|string|mapping|multiset|array|object");
}
}
}
/*! @decl mixed `-(mixed arg1)
*! @decl mixed `-(mixed arg1, mixed arg2, mixed ... extras)
*! @decl mixed `-(object arg1, mixed arg2)
*! @decl mixed `-(mixed arg1, object arg2)
*! @decl int `-(int arg1, int arg2)
*! @decl float `-(float arg1, int|float arg2)
*! @decl float `-(int|float arg1, float arg2)
*! @decl string `-(string arg1, string arg2)
*! @decl array `-(array arg1, array arg2)
*! @decl mapping `-(mapping arg1, array arg2)
*! @decl mapping `-(mapping arg1, mapping arg2)
*! @decl mapping `-(mapping arg1, multiset arg2)
*! @decl multiset `-(multiset arg1, multiset arg2)
*!
*! Negation/subtraction/set difference.
*!
*! Every expression with the @expr{-@} operator becomes a call to
*! this function, i.e. @expr{-a@} is the same as
*! @expr{predef::`-(a)@} and @expr{a-b@} is the same as
*! @expr{predef::`-(a,b)@}. Longer @expr{-@} expressions are
*! normally optimized to one call, so e.g. @expr{a-b-c@} becomes
*! @expr{predef::`-(a,b,c)@}.
*!
*! @returns
*! If there's a single argument, that argument is returned negated.
*! If @[arg1] is an object with an @[lfun::`-()], that function is
*! called without arguments, and its result is returned.
*!
*! If there are more than two arguments the result is:
*! @expr{`-(`-(@[arg1], @[arg2]), @@@[extras])@}.
*!
*! Otherwise, if @[arg1] is an object with an @[lfun::`-()], that
*! function is called with @[arg2] as argument, and its result is
*! returned.
*!
*! Otherwise, if @[arg2] is an object with an @[lfun::``-()], that
*! function is called with @[arg1] as argument, and its result is
*! returned.
*!
*! Otherwise the result depends on the argument types:
*! @mixed arg1
*! @type int|float
*! The result is @expr{@[arg1] - @[arg2]@}, and is a float if
*! either @[arg1] or @[arg2] is a float.
*! @type string
*! The result is @[arg1] with all nonoverlapping occurrences of
*! the substring @[arg2] removed. In cases with two overlapping
*! occurrences, the leftmost is removed.
*! @type array|mapping|multiset
*! The result is like @[arg1] but without the elements/indices
*! that match any in @[arg2] (according to @[`==] and, in the
*! case of mappings, @[hash_value]).
*! @endmixed
*! The function is not destructive on the arguments - the result is
*! always a new instance. *!
*! @note
*! In Pike 7.0 and earlier the subtraction order was unspecified.
*!
*! @seealso
*! @[`+()]
*/
PMOD_EXPORT void f_minus(INT32 args)
{
switch(args)
{
case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`-", 1);
case 1: o_negate(); break;
case 2: o_subtract(); break;
default:
{
INT32 e;
struct svalue *s=sp-args;
push_svalue(s);
for(e=1;e<args;e++)
{
push_svalue(s+e);
o_subtract();
}
assign_svalue(s,sp-1);
pop_n_elems(sp-s-1);
}
}
}
static int generate_minus(node *n)
{
switch(count_args(CDR(n)))
{
case 1:
do_docode(CDR(n),DO_NOT_COPY);
emit0(F_NEGATE);
return 1;
case 2:
do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
emit0(F_SUBTRACT);
return 1;
}
return 0;
}
PMOD_EXPORT void o_and(void)
{
if(sp[-1].type != sp[-2].type)
{
if(call_lfun(LFUN_AND, LFUN_RAND))
return;
else if (((sp[-1].type == T_TYPE) || (sp[-1].type == T_PROGRAM) ||
(sp[-1].type == T_FUNCTION)) &&
((sp[-2].type == T_TYPE) || (sp[-2].type == T_PROGRAM) ||
(sp[-2].type == T_FUNCTION)))
{
if (sp[-2].type != T_TYPE)
{
struct program *p = program_from_svalue(sp - 2);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`&", 1, "type");
}
type_stack_mark();
push_object_type(0, p->id);
free_svalue(sp - 2);
sp[-2].u.type = pop_unfinished_type();
sp[-2].type = T_TYPE; }
if (sp[-1].type != T_TYPE)
{
struct program *p = program_from_svalue(sp - 1);
if (!p)
{
int args = 2;
SIMPLE_BAD_ARG_ERROR("`&", 2, "type");
}
type_stack_mark();
push_object_type(0, p->id);
free_svalue(sp - 1);
sp[-1].u.type = pop_unfinished_type();
sp[-1].type = T_TYPE;
}
}
else if (sp[-2].type==T_MAPPING)
switch (sp[-1].type)
{
case T_ARRAY:
{
struct mapping *m;
m=merge_mapping_array_unordered(sp[-2].u.mapping,
sp[-1].u.array,
PIKE_ARRAY_OP_AND);
pop_n_elems(2);
push_mapping(m);
return;
}
case T_MULTISET:
{
struct mapping *m;
#ifdef PIKE_NEW_MULTISETS
int got_cmp_less = !!multiset_get_cmp_less (sp[-1].u.multiset);
struct array *ind = multiset_indices (sp[-1].u.multiset);
pop_stack();
push_array (ind);
if (got_cmp_less)
m=merge_mapping_array_unordered(sp[-2].u.mapping,
sp[-1].u.array,
PIKE_ARRAY_OP_AND);
else
m=merge_mapping_array_ordered(sp[-2].u.mapping,
sp[-1].u.array,
PIKE_ARRAY_OP_AND);
#else
m=merge_mapping_array_ordered(sp[-2].u.mapping,
sp[-1].u.multiset->ind,
PIKE_ARRAY_OP_AND);
#endif
pop_n_elems(2);
push_mapping(m);
return;
}
default:
{
int args = 2;
SIMPLE_BAD_ARG_ERROR("`&", 2, "mapping");
}
}
else
{
int args = 2;
SIMPLE_BAD_ARG_ERROR("`&", 2, get_name_of_type(sp[-2].type));
}
}
switch(sp[-2].type)
{
case T_OBJECT:
CALL_OPERATOR(LFUN_AND,2);
break;
case T_INT:
sp--;
sp[-1].u.integer &= sp[0].u.integer;
break;
case T_MAPPING:
{
struct mapping *m;
m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping, PIKE_ARRAY_OP_AND);
pop_n_elems(2);
push_mapping(m);
return;
}
case T_MULTISET:
{
struct multiset *l;
l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_AND);
pop_n_elems(2);
push_multiset(l);
return;
}
case T_ARRAY:
{
struct array *a;
a=and_arrays(sp[-2].u.array, sp[-1].u.array);
pop_n_elems(2);
push_array(a);
return;
}
case T_TYPE:
{
struct pike_type *t;
t = and_pike_types(sp[-2].u.type, sp[-1].u.type);
pop_n_elems(2);
push_type_value(t);
return;
}
case T_FUNCTION:
case T_PROGRAM:
{
struct program *p;
struct pike_type *a;
struct pike_type *b;
struct pike_type *t;
p = program_from_svalue(sp - 2);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`&", 1, "type");
}
type_stack_mark();
push_object_type(0, p->id);
a = pop_unfinished_type();
p = program_from_svalue(sp - 1);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`&", 2, "type");
}
type_stack_mark(); push_object_type(0, p->id);
b = pop_unfinished_type();
t = and_pike_types(a, b);
pop_n_elems(2);
push_type_value(t);
free_type(a);
free_type(b);
return;
}
#define STRING_BITOP(OP,STROP) \
case T_STRING: \
{ \
struct pike_string *s; \
ptrdiff_t len, i; \
\
len = sp[-2].u.string->len; \
if (len != sp[-1].u.string->len) \
PIKE_ERROR("`" #OP, "Bitwise "STROP \
" on strings of different lengths.\n", sp, 2); \
if(!sp[-2].u.string->size_shift && !sp[-1].u.string->size_shift) \
{ \
s = begin_shared_string(len); \
for (i=0; i<len; i++) \
s->str[i] = sp[-2].u.string->str[i] OP sp[-1].u.string->str[i]; \
}else{ \
s = begin_wide_shared_string(len, \
MAXIMUM(sp[-2].u.string->size_shift, \
sp[-1].u.string->size_shift)); \
for (i=0; i<len; i++) \
low_set_index(s,i,index_shared_string(sp[-2].u.string,i) OP \
index_shared_string(sp[-1].u.string,i)); \
} \
pop_n_elems(2); \
push_string(end_shared_string(s)); \
return; \
}
STRING_BITOP(&,"AND")
default:
PIKE_ERROR("`&", "Bitwise AND on illegal type.\n", sp, 2);
}
}
/* This function is used to speed up or/xor/and on
* arrays multisets and mappings. This is done by
* calling the operator for each pair of arguments
* first, then recursively doing the same on the
* results until only one value remains.
*/
static void r_speedup(INT32 args, void (*func)(void))
{
struct svalue tmp;
ONERROR err;
switch(args)
{
case 3: func();
case 2: func();
case 1: return;
default:
r_speedup((args+1)>>1,func);
dmalloc_touch_svalue(Pike_sp-1);
tmp=*--sp;
SET_ONERROR(err,do_free_svalue,&tmp);
r_speedup(args>>1,func); UNSET_ONERROR(err);
sp++[0]=tmp;
func();
}
}
static void speedup(INT32 args, void (*func)(void))
{
switch(sp[-args].type)
{
/* This method can be used for types where a op b === b op a */
case T_MULTISET:
#ifndef PIKE_NEW_MULTISETS
{
int e=-1;
while(args > 1)
{
struct svalue tmp;
func();
args--;
e++;
if(e - args >= -1)
{
e=0;
}else{
tmp=sp[e-args];
sp[e-args]=sp[-1];
sp[-1]=tmp;
}
}
return;
}
#endif
/* Binary balanced tree method for types where
* a op b may or may not be equal to b op a
*/
case T_ARRAY:
case T_MAPPING:
r_speedup(args,func);
return;
default:
while(--args > 0) func();
}
}
/*! @decl mixed `&(mixed arg1)
*! @decl mixed `&(mixed arg1, mixed arg2, mixed ... extras)
*! @decl mixed `&(object arg1, mixed arg2)
*! @decl mixed `&(mixed arg1, object arg2)
*! @decl int `&(int arg1, int arg2)
*! @decl string `&(string arg1, string arg2)
*! @decl array `&(array arg1, array arg2)
*! @decl mapping `&(mapping arg1, mapping arg2)
*! @decl mapping `&(mapping arg1, array arg2)
*! @decl mapping `&(mapping arg1, multiset arg2)
*! @decl multiset `&(multiset arg1, multiset arg2)
*! @decl type `&(type|program arg1, type|program arg2)
*!
*! Bitwise and/intersection.
*!
*! Every expression with the @expr{&@} operator becomes a call to
*! this function, i.e. @expr{a&b@} is the same as
*! @expr{predef::`&(a,b)@}.
*!
*! @returns
*! If there's a single argument, that argument is returned.
*!
*! If there are more than two arguments the result is:
*! @expr{`&(`&(@[arg1], @[arg2]), @@@[extras])@}. *!
*! Otherwise, if @[arg1] is an object with an @[lfun::`&()], that
*! function is called with @[arg2] as argument, and its result is
*! returned.
*!
*! Otherwise, if @[arg2] is an object with an @[lfun::``&()], that
*! function is called with @[arg1] as argument, and its result is
*! returned.
*!
*! Otherwise the result depends on the argument types:
*! @mixed arg1
*! @type int
*! Bitwise and of @[arg1] and @[arg2].
*! @type string
*! The result is a string where each character is the bitwise
*! and of the characters in the same position in @[arg1] and
*! @[arg2]. The arguments must be strings of the same length.
*! @type array|mapping|multiset
*! The result is like @[arg1] but only with the
*! elements/indices that match any in @[arg2] (according to
*! @[`==] and, in the case of mappings, @[hash_value]).
*! @type type|program
*! Type intersection of @[arg1] and @[arg2].
*! @endmixed
*! The function is not destructive on the arguments - the result is
*! always a new instance.
*!
*! @seealso
*! @[`|()], @[lfun::`&()], @[lfun::``&()]
*/
PMOD_EXPORT void f_and(INT32 args)
{
switch(args)
{
case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`&", 1);
case 1: return;
case 2: o_and(); return;
default:
if(sp[-args].type == T_OBJECT)
{
CALL_OPERATOR(LFUN_AND, args);
}else{
speedup(args, o_and);
}
}
}
static int generate_and(node *n)
{
switch(count_args(CDR(n)))
{
case 1:
do_docode(CDR(n),0);
return 1;
case 2:
do_docode(CDR(n),0);
emit0(F_AND);
return 1;
default:
return 0;
}
}
PMOD_EXPORT void o_or(void)
{
if(sp[-1].type != sp[-2].type)
{
if(call_lfun(LFUN_OR, LFUN_ROR)) { return;
} else if (((sp[-1].type == T_TYPE) || (sp[-1].type == T_PROGRAM) ||
(sp[-1].type == T_FUNCTION)) &&
((sp[-2].type == T_TYPE) || (sp[-2].type == T_PROGRAM) ||
(sp[-2].type == T_FUNCTION))) {
if (sp[-2].type != T_TYPE) {
struct program *p = program_from_svalue(sp - 2);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`|", 1, "type");
}
type_stack_mark();
push_object_type(0, p->id);
free_svalue(sp - 2);
sp[-2].u.type = pop_unfinished_type();
sp[-2].type = T_TYPE;
}
if (sp[-1].type != T_TYPE) {
struct program *p = program_from_svalue(sp - 1);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`|", 2, "type");
}
type_stack_mark();
push_object_type(0, p->id);
free_svalue(sp - 1);
sp[-1].u.type = pop_unfinished_type();
sp[-1].type = T_TYPE;
}
} else {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`|", 2, get_name_of_type(sp[-2].type));
}
}
switch(sp[-2].type)
{
case T_OBJECT:
CALL_OPERATOR(LFUN_OR,2);
break;
case T_INT:
sp--;
sp[-1].u.integer |= sp[0].u.integer;
break;
case T_MAPPING:
{
struct mapping *m;
m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping, PIKE_ARRAY_OP_OR);
pop_n_elems(2);
push_mapping(m);
return;
}
case T_MULTISET:
{
struct multiset *l;
l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_OR_LEFT);
pop_n_elems(2);
push_multiset(l);
return;
}
case T_ARRAY:
{
struct array *a;
a=merge_array_with_order(sp[-2].u.array, sp[-1].u.array, PIKE_ARRAY_OP_OR_LEFT);
pop_n_elems(2);
push_array(a); return;
}
case T_TYPE:
{
struct pike_type *t;
t = or_pike_types(sp[-2].u.type, sp[-1].u.type, 0);
pop_n_elems(2);
push_type_value(t);
return;
}
case T_FUNCTION:
case T_PROGRAM:
{
struct program *p;
struct pike_type *a;
struct pike_type *b;
struct pike_type *t;
p = program_from_svalue(sp - 2);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`|", 1, "type");
}
type_stack_mark();
push_object_type(0, p->id);
a = pop_unfinished_type();
p = program_from_svalue(sp - 1);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`|", 2, "type");
}
type_stack_mark();
push_object_type(0, p->id);
b = pop_unfinished_type();
t = or_pike_types(a, b, 0);
pop_n_elems(2);
push_type_value(t);
free_type(a);
free_type(b);
return;
}
STRING_BITOP(|,"OR")
default:
PIKE_ERROR("`|", "Bitwise OR on illegal type.\n", sp, 2);
}
}
/*! @decl mixed `|(mixed arg1)
*! @decl mixed `|(mixed arg1, mixed arg2, mixed ... extras)
*! @decl mixed `|(object arg1, mixed arg2)
*! @decl mixed `|(mixed arg1, object arg2)
*! @decl int `|(int arg1, int arg2)
*! @decl string `|(string arg1, string arg2)
*! @decl array `|(array arg1, array arg2)
*! @decl mapping `|(mapping arg1, mapping arg2)
*! @decl multiset `|(multiset arg1, multiset arg2)
*! @decl type `|(program|type arg1, program|type arg2)
*!
*! Bitwise or/union.
*!
*! Every expression with the @expr{|@} operator becomes a call to
*! this function, i.e. @expr{a|b@} is the same as
*! @expr{predef::`|(a,b)@}. *!
*! @returns
*! If there's a single argument, that argument is returned.
*!
*! If there are more than two arguments, the result is:
*! @expr{`|(`|(@[arg1], @[arg2]), @@@[extras])@}.
*!
*! Otherwise, if @[arg1] is an object with an @[lfun::`|()], that
*! function is called with @[arg2] as argument, and its result is
*! returned.
*!
*! Otherwise, if @[arg2] is an object with an @[lfun::``|()], that
*! function is called with @[arg1] as argument, and its result is
*! returned.
*!
*! Otherwise the result depends on the argument types:
*! @mixed arg1
*! @type int
*! Bitwise or of @[arg1] and @[arg2].
*! @type string
*! The result is a string where each character is the bitwise
*! or of the characters in the same position in @[arg1] and
*! @[arg2]. The arguments must be strings of the same length.
*! @type array
*! The result is an array with the elements in @[arg1]
*! concatenated with those in @[arg2] that doesn't occur in
*! @[arg1] (according to @[`==]). The order between the
*! elements that come from the same argument is kept.
*!
*! Every element in @[arg1] is only matched once against an
*! element in @[arg2], so if @[arg2] contains several elements
*! that are equal to each other and are more than their
*! counterparts in @[arg1], the rightmost remaining elements in
*! @[arg2] are kept.
*! @type mapping
*! The result is like @[arg1] but extended with the entries
*! from @[arg2]. If the same index (according to @[hash_value]
*! and @[`==]) occur in both, the value from @[arg2] is used.
*! @type multiset
*! The result is like @[arg1] but extended with the entries in
*! @[arg2] that doesn't already occur in @[arg1] (according to
*! @[`==]). Subsequences with orderwise equal entries (i.e.
*! where @[`<] returns false) are handled just like the array
*! case above.
*! @type type|program
*! Type union of @[arg1] and @[arg2].
*! @endmixed
*! The function is not destructive on the arguments - the result is
*! always a new instance.
*!
*! @seealso
*! @[`&()], @[lfun::`|()], @[lfun::``|()]
*/
PMOD_EXPORT void f_or(INT32 args)
{
switch(args)
{
case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`|", 1);
case 1: return;
case 2: o_or(); return;
default:
if(sp[-args].type==T_OBJECT)
{
CALL_OPERATOR(LFUN_OR, args);
} else {
speedup(args, o_or);
}
}
}
static int generate_or(node *n)
{
switch(count_args(CDR(n)))
{
case 1:
do_docode(CDR(n),0);
return 1;
case 2:
do_docode(CDR(n),0);
emit0(F_OR);
return 1;
default:
return 0;
}
}
PMOD_EXPORT void o_xor(void)
{
if(sp[-1].type != sp[-2].type)
{
if(call_lfun(LFUN_XOR, LFUN_RXOR)) {
return;
} else if (((sp[-1].type == T_TYPE) || (sp[-1].type == T_PROGRAM) ||
(sp[-1].type == T_FUNCTION)) &&
((sp[-2].type == T_TYPE) || (sp[-2].type == T_PROGRAM) ||
(sp[-2].type == T_FUNCTION))) {
if (sp[-2].type != T_TYPE) {
struct program *p = program_from_svalue(sp - 2);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`^", 1, "type");
}
type_stack_mark();
push_object_type(0, p->id);
free_svalue(sp - 2);
sp[-2].u.type = pop_unfinished_type();
sp[-2].type = T_TYPE;
}
if (sp[-1].type != T_TYPE) {
struct program *p = program_from_svalue(sp - 1);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`^", 2, "type");
}
type_stack_mark();
push_object_type(0, p->id);
free_svalue(sp - 1);
sp[-1].u.type = pop_unfinished_type();
sp[-1].type = T_TYPE;
}
} else {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`^", 2, get_name_of_type(sp[-2].type));
}
}
switch(sp[-2].type)
{
case T_OBJECT:
CALL_OPERATOR(LFUN_XOR,2);
break;
case T_INT:
sp--;
sp[-1].u.integer ^= sp[0].u.integer;
break;
case T_MAPPING:
{
struct mapping *m;
m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping, PIKE_ARRAY_OP_XOR);
pop_n_elems(2);
push_mapping(m);
return;
}
case T_MULTISET:
{
struct multiset *l;
l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_XOR);
pop_n_elems(2);
push_multiset(l);
return;
}
case T_ARRAY:
{
struct array *a;
a=merge_array_with_order(sp[-2].u.array, sp[-1].u.array, PIKE_ARRAY_OP_XOR);
pop_n_elems(2);
push_array(a);
return;
}
case T_FUNCTION:
case T_PROGRAM:
{
struct program *p;
p = program_from_svalue(sp - 1);
if (!p) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`^", 2, "type");
}
type_stack_mark();
push_object_type(0, p->id);
pop_stack();
push_type_value(pop_unfinished_type());
stack_swap();
p = program_from_svalue(sp - 1);
if (!p) {
int args = 2;
stack_swap();
SIMPLE_BAD_ARG_ERROR("`^", 1, "type");
}
type_stack_mark();
push_object_type(0, p->id);
pop_stack();
push_type_value(pop_unfinished_type());
}
/* FALL_THROUGH */
case T_TYPE:
{
/* a ^ b == (a&~b)|(~a&b) */
struct pike_type *a;
struct pike_type *b;
copy_pike_type(a, sp[-2].u.type);
copy_pike_type(b, sp[-1].u.type);
o_compl(); /* ~b */
o_and(); /* a&~b */
push_type_value(a);
o_compl(); /* ~a */
push_type_value(b);
o_and(); /* ~a&b */
o_or(); /* (a&~b)|(~a&b) */ return;
}
STRING_BITOP(^,"XOR")
default:
PIKE_ERROR("`^", "Bitwise XOR on illegal type.\n", sp, 2);
}
}
/*! @decl mixed `^(mixed arg1)
*! @decl mixed `^(mixed arg1, mixed arg2, mixed ... extras)
*! @decl mixed `^(object arg1, mixed arg2)
*! @decl mixed `^(mixed arg1, object arg2)
*! @decl int `^(int arg1, int arg2)
*! @decl string `^(string arg1, string arg2)
*! @decl array `^(array arg1, array arg2)
*! @decl mapping `^(mapping arg1, mapping arg2)
*! @decl multiset `^(multiset arg1, multiset arg2)
*! @decl type `^(program|type arg1, program|type arg2)
*!
*! Exclusive or.
*!
*! Every expression with the @expr{^@} operator becomes a call to
*! this function, i.e. @expr{a^b@} is the same as
*! @expr{predef::`^(a,b)@}.
*!
*! @returns
*! If there's a single argument, that argument is returned.
*!
*! If there are more than two arguments, the result is:
*! @expr{`^(`^(@[arg1], @[arg2]), @@@[extras])@}.
*!
*! Otherwise, if @[arg1] is an object with an @[lfun::`^()], that
*! function is called with @[arg2] as argument, and its result is
*! returned.
*!
*! Otherwise, if @[arg2] is an object with an @[lfun::``^()], that
*! function is called with @[arg1] as argument, and its result is
*! returned.
*!
*! Otherwise the result depends on the argument types:
*! @mixed arg1
*! @type int
*! Bitwise exclusive or of @[arg1] and @[arg2].
*! @type string
*! The result is a string where each character is the bitwise
*! exclusive or of the characters in the same position in
*! @[arg1] and @[arg2]. The arguments must be strings of the
*! same length.
*! @type array
*! The result is an array with the elements in @[arg1] that
*! doesn't occur in @[arg2] concatenated with those in @[arg2]
*! that doesn't occur in @[arg1] (according to @[`==]). The
*! order between the elements that come from the same argument
*! is kept.
*!
*! Every element is only matched once against an element in the
*! other array, so if one contains several elements that are
*! equal to each other and are more than their counterparts in
*! the other array, the rightmost remaining elements are kept.
*! @type mapping
*! The result is like @[arg1] but with the entries from @[arg1]
*! and @[arg2] whose indices are different between them
*! (according to @[hash_value] and @[`==]).
*! @type multiset
*! The result is like @[arg1] but with the entries from @[arg1]
*! and @[arg2] that are different between them (according to
*! @[hash_value] and @[`==]). Subsequences with orderwise equal
*! entries (i.e. where @[`<] returns false) are handled just *! like the array case above.
*! @type type|program
*! The result is a type computed like this:
*! @expr{(@[arg1]&~@[arg2])|(~@[arg1]&@[arg2])@}.
*! @endmixed
*! The function is not destructive on the arguments - the result is
*! always a new instance.
*!
*! @seealso
*! @[`&()], @[`|()], @[lfun::`^()], @[lfun::``^()]
*/
PMOD_EXPORT void f_xor(INT32 args)
{
switch(args)
{
case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`^", 1);
case 1: return;
case 2: o_xor(); return;
default:
if(sp[-args].type==T_OBJECT)
{
CALL_OPERATOR(LFUN_XOR, args);
} else {
speedup(args, o_xor);
}
}
}
static int generate_xor(node *n)
{
switch(count_args(CDR(n)))
{
case 1:
do_docode(CDR(n),0);
return 1;
case 2:
do_docode(CDR(n),0);
emit0(F_XOR);
return 1;
default:
return 0;
}
}
PMOD_EXPORT void o_lsh(void)
{
#ifdef AUTO_BIGNUM
if ((sp[-1].type == T_INT) && (sp[-2].type == T_INT) &&
INT_TYPE_LSH_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer))
convert_stack_top_to_bignum();
#endif /* AUTO_BIGNUM */
if(sp[-1].type != T_INT || sp[-2].type != T_INT)
{
int args = 2;
if(call_lfun(LFUN_LSH, LFUN_RLSH))
return;
if(sp[-2].type != T_INT)
SIMPLE_BAD_ARG_ERROR("`<<", 1, "int|object");
SIMPLE_BAD_ARG_ERROR("`<<", 2, "int(0..)|object");
}
#ifndef AUTO_BIGNUM
if (sp[-1].u.integer > 31) {
sp--;
sp[-1].u.integer = 0;
return;
}#endif /* !AUTO_BIGNUM */
if (sp[-1].u.integer < 0) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`<<", 2, "int(0..)|object");
}
sp--;
sp[-1].u.integer = sp[-1].u.integer << sp->u.integer;
}
/*! @decl int `<<(int arg1, int arg2)
*! @decl mixed `<<(object arg1, int|object arg2)
*! @decl mixed `<<(int arg1, object arg2)
*!
*! Left shift.
*!
*! Every expression with the @expr{<<@} operator becomes a call to
*! this function, i.e. @expr{a<<b@} is the same as
*! @expr{predef::`<<(a,b)@}.
*!
*! If @[arg1] is an object that implements @[lfun::`<<()], that
*! function will be called with @[arg2] as the single argument.
*!
*! If @[arg2] is an object that implements @[lfun::``<<()], that
*! function will be called with @[arg1] as the single argument.
*!
*! Otherwise @[arg1] will be shifted @[arg2] bits left.
*!
*! @seealso
*! @[`>>()]
*/
PMOD_EXPORT void f_lsh(INT32 args)
{
if(args != 2) {
/* FIXME: Not appropriate if too many args. */
SIMPLE_TOO_FEW_ARGS_ERROR("`<<", 2);
}
o_lsh();
}
static int generate_lsh(node *n)
{
if(count_args(CDR(n))==2)
{
do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
emit0(F_LSH);
return 1;
}
return 0;
}
PMOD_EXPORT void o_rsh(void)
{
if(sp[-2].type != T_INT || sp[-1].type != T_INT)
{
int args = 2;
if(call_lfun(LFUN_RSH, LFUN_RRSH))
return;
if(sp[-2].type != T_INT)
SIMPLE_BAD_ARG_ERROR("`>>", 1, "int|object");
SIMPLE_BAD_ARG_ERROR("`>>", 2, "int(0..)|object");
}
if (sp[-1].u.integer < 0) {
int args = 2;
SIMPLE_BAD_ARG_ERROR("`>>", 2, "int(0..)|object");
}
if(
#ifdef AUTO_BIGNUM
(INT_TYPE_RSH_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer))#else /* !AUTO_BIGNUM */
(sp[-1].u.integer > 31)
#endif /* AUTO_BIGNUM */
)
{
sp--;
if (sp[-1].u.integer < 0) {
sp[-1].u.integer = -1;
} else {
sp[-1].u.integer = 0;
}
return;
}
sp--;
sp[-1].u.integer = sp[-1].u.integer >> sp->u.integer;
}
/*! @decl int `>>(int arg1, int arg2)
*! @decl mixed `>>(object arg1, int|object arg2)
*! @decl mixed `>>(int arg1, object arg2)
*!
*! Right shift.
*!
*! Every expression with the @expr{>>@} operator becomes a call to
*! this function, i.e. @expr{a>>b@} is the same as
*! @expr{predef::`>>(a,b)@}.
*!
*! If @[arg1] is an object that implements @[lfun::`>>()], that
*! function will be called with @[arg2] as the single argument.
*!
*! If @[arg2] is an object that implements @[lfun::``>>()], that
*! function will be called with @[arg1] as the single argument.
*!
*! Otherwise @[arg1] will be shifted @[arg2] bits right.
*!
*! @seealso
*! @[`<<()]
*/
PMOD_EXPORT void f_rsh(INT32 args)
{
if(args != 2) {
/* FIXME: Not appropriate if too many args. */
SIMPLE_TOO_FEW_ARGS_ERROR("`>>", 2);
}
o_rsh();
}
static int generate_rsh(node *n)
{
if(count_args(CDR(n))==2)
{
do_docode(CDR(n),DO_NOT_COPY);
emit0(F_RSH);
return 1;
}
return 0;
}
#define TWO_TYPES(X,Y) (((X)<<8)|(Y))
PMOD_EXPORT void o_multiply(void)
{
int args = 2;
switch(TWO_TYPES(sp[-2].type,sp[-1].type))
{
case TWO_TYPES(T_ARRAY, T_INT):
{
struct array *ret;
struct svalue *pos; INT32 e;
if(sp[-1].u.integer < 0)
SIMPLE_BAD_ARG_ERROR("`*", 2, "int(0..)");
ret=allocate_array(sp[-2].u.array->size * sp[-1].u.integer);
pos=ret->item;
for(e=0;e<sp[-1].u.integer;e++,pos+=sp[-2].u.array->size)
assign_svalues_no_free(pos,
sp[-2].u.array->item,
sp[-2].u.array->size,
sp[-2].u.array->type_field);
ret->type_field=sp[-2].u.array->type_field;
pop_n_elems(2);
push_array(ret);
return;
}
case TWO_TYPES(T_ARRAY, T_FLOAT):
{
struct array *src;
struct array *ret;
struct svalue *pos;
ptrdiff_t asize, delta;
if(sp[-1].u.float_number < 0)
SIMPLE_BAD_ARG_ERROR("`*", 2, "float(0..)");
src = sp[-2].u.array;
delta = src->size;
asize = (ptrdiff_t)floor(delta * sp[-1].u.float_number + 0.5);
ret = allocate_array(asize);
pos = ret->item;
if (asize > delta) {
ret->type_field = src->type_field;
assign_svalues_no_free(pos,
src->item,
delta,
src->type_field);
pos += delta;
asize -= delta;
while (asize > delta) {
assign_svalues_no_free(pos, ret->item, delta, ret->type_field);
pos += delta;
asize -= delta;
delta <<= 1;
}
if (asize) {
assign_svalues_no_free(pos, ret->item, asize, ret->type_field);
}
} else if (asize) {
ret->type_field =
assign_svalues_no_free(pos,
src->item,
asize,
src->type_field);
}
pop_n_elems(2);
push_array(ret);
return;
}
case TWO_TYPES(T_STRING, T_FLOAT):
{
struct pike_string *src;
struct pike_string *ret;
char *pos;
ptrdiff_t len, delta;
if(sp[-1].u.float_number < 0)
SIMPLE_BAD_ARG_ERROR("`*", 2, "float(0..)");
src = sp[-2].u.string;
len = (ptrdiff_t)floor(src->len * sp[-1].u.float_number + 0.5); ret = begin_wide_shared_string(len, src->size_shift);
len <<= src->size_shift;
delta = src->len << src->size_shift;
pos = ret->str;
if (len > delta) {
MEMCPY(pos, src->str, delta);
pos += delta;
len -= delta;
while (len > delta) {
MEMCPY(pos, ret->str, delta);
pos += delta;
len -= delta;
delta <<= 1;
}
if (len) {
MEMCPY(pos, ret->str, len);
}
} else if (len) {
MEMCPY(pos, src->str, len);
}
pop_n_elems(2);
push_string(low_end_shared_string(ret));
return;
}
case TWO_TYPES(T_STRING, T_INT):
{
struct pike_string *ret;
char *pos;
INT_TYPE e;
ptrdiff_t len;
if(sp[-1].u.integer < 0)
SIMPLE_BAD_ARG_ERROR("`*", 2, "int(0..)");
ret=begin_wide_shared_string(sp[-2].u.string->len * sp[-1].u.integer,
sp[-2].u.string->size_shift);
pos=ret->str;
len=sp[-2].u.string->len << sp[-2].u.string->size_shift;
for(e=0;e<sp[-1].u.integer;e++,pos+=len)
MEMCPY(pos,sp[-2].u.string->str,len);
pop_n_elems(2);
push_string(low_end_shared_string(ret));
return;
}
case TWO_TYPES(T_ARRAY,T_STRING):
{
struct pike_string *ret;
ret=implode(sp[-2].u.array,sp[-1].u.string);
free_string(sp[-1].u.string);
free_array(sp[-2].u.array);
sp[-2].type=T_STRING;
sp[-2].u.string=ret;
sp--;
return;
}
case TWO_TYPES(T_ARRAY,T_ARRAY):
{
struct array *ret;
ret=implode_array(sp[-2].u.array, sp[-1].u.array);
pop_n_elems(2);
push_array(ret);
return;
}
case TWO_TYPES(T_FLOAT,T_FLOAT):
sp--;
sp[-1].u.float_number *= sp[0].u.float_number; return;
case TWO_TYPES(T_FLOAT,T_INT):
sp--;
sp[-1].u.float_number *= (FLOAT_TYPE)sp[0].u.integer;
return;
case TWO_TYPES(T_INT,T_FLOAT):
sp--;
sp[-1].u.float_number=
(FLOAT_TYPE) sp[-1].u.integer * sp[0].u.float_number;
sp[-1].type=T_FLOAT;
return;
case TWO_TYPES(T_INT,T_INT):
#ifdef AUTO_BIGNUM
if(INT_TYPE_MUL_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer))
{
convert_stack_top_to_bignum();
goto do_lfun_multiply;
}
#endif /* AUTO_BIGNUM */
sp--;
sp[-1].u.integer *= sp[0].u.integer;
return;
default:
do_lfun_multiply:
if(call_lfun(LFUN_MULTIPLY, LFUN_RMULTIPLY))
return;
PIKE_ERROR("`*", "Bad arguments.\n", sp, 2);
}
}
/*! @decl mixed `*(mixed arg1)
*! @decl mixed `*(object arg1, mixed arg2, mixed ... extras)
*! @decl mixed `*(mixed arg1, object arg2)
*! @decl array `*(array arg1, int arg2)
*! @decl array `*(array arg1, float arg2)
*! @decl string `*(string arg1, int arg2)
*! @decl string `*(string arg1, float arg2)
*! @decl string `*(array(string) arg1, string arg2)
*! @decl array `*(array(array) arg1, array arg2)
*! @decl float `*(float arg1, int|float arg2)
*! @decl float `*(int arg1, float arg2)
*! @decl int `*(int arg1, int arg2)
*! @decl mixed `*(mixed arg1, mixed arg2, mixed ... extras)
*!
*! Multiplication/repetition/implosion.
*!
*! Every expression with the @expr{*@} operator becomes a call to
*! this function, i.e. @expr{a*b@} is the same as
*! @expr{predef::`*(a,b)@}. Longer @expr{*@} expressions are
*! normally optimized to one call, so e.g. @expr{a*b*c@} becomes
*! @expr{predef::`*(a,b,c)@}.
*!
*! @returns
*! If there's a single argument, that argument will be returned.
*!
*! If the first argument is an object that implements @[lfun::`*()],
*! that function will be called with the rest of the arguments.
*!
*! If there are more than two arguments, the result will be
*! @expr{`*(`*(@[arg1], @[arg2]), @@@[extras])@}.
*!
*! If @[arg2] is an object that implements @[lfun::``*()], that
*! function will be called with @[arg1] as the single argument.
*!
*! Otherwise the result will be as follows: *! @mixed arg1
*! @type array
*! @mixed arg2
*! @type int|float
*! The result will be @[arg1] concatenated @[arg2] times.
*! @type string|array
*! The result will be the elements of @[arg1] concatenated with
*! @[arg2] interspersed.
*! @endmixed
*! @type string
*! The result will be @[arg1] concatenated @[arg2] times.
*! @type int|float
*! The result will be @expr{@[arg1] * @[arg2]@}, and will be a
*! float if either @[arg1] or @[arg2] is a float.
*! @endmixed
*!
*! @note
*! In Pike 7.0 and earlier the multiplication order was unspecified.
*!
*! @seealso
*! @[`+()], @[`-()], @[`/()], @[lfun::`*()], @[lfun::``*()]
*/
PMOD_EXPORT void f_multiply(INT32 args)
{
switch(args)
{
case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`*", 1);
case 1: return;
case 2: o_multiply(); return;
default:
if(sp[-args].type==T_OBJECT)
{
CALL_OPERATOR(LFUN_MULTIPLY, args);
} else {
INT32 i = -args, j = -1;
/* Reverse the arguments */
while(i < j) {
struct svalue tmp = sp[i];
sp[i++] = sp[j];
sp[j--] = tmp;
}
while(--args > 0) {
/* Restore the order, and multiply */
stack_swap();
o_multiply();
}
}
}
}
static int generate_multiply(node *n)
{
switch(count_args(CDR(n)))
{
case 1:
do_docode(CDR(n),0);
return 1;
case 2:
do_docode(CDR(n),0);
emit0(F_MULTIPLY);
return 1;
default:
return 0;
}
}
PMOD_EXPORT void o_divide(void)
{ if(sp[-2].type!=sp[-1].type && !float_promote())
{
if(call_lfun(LFUN_DIVIDE, LFUN_RDIVIDE))
return;
switch(TWO_TYPES(sp[-2].type,sp[-1].type))
{
case TWO_TYPES(T_STRING,T_INT):
{
struct array *a;
INT_TYPE len;
ptrdiff_t size,e,pos=0;
len=sp[-1].u.integer;
if(!len)
OP_DIVISION_BY_ZERO_ERROR("`/");
if(len<0)
{
len=-len;
size=sp[-2].u.string->len / len;
pos+=sp[-2].u.string->len % len;
}else{
size=sp[-2].u.string->len / len;
}
a=allocate_array(size);
for(e=0;e<size;e++)
{
a->item[e].u.string=string_slice(sp[-2].u.string, pos,len);
a->item[e].type=T_STRING;
pos+=len;
}
a->type_field=BIT_STRING;
pop_n_elems(2);
push_array(a);
return;
}
case TWO_TYPES(T_STRING,T_FLOAT):
{
struct array *a;
ptrdiff_t size, pos, last, e;
FLOAT_ARG_TYPE len;
len=sp[-1].u.float_number;
if(len==0.0)
OP_DIVISION_BY_ZERO_ERROR("`/");
if(len<0)
{
len=-len;
size=(ptrdiff_t)ceil( ((double)sp[-2].u.string->len) / len);
a=allocate_array(size);
for(last=sp[-2].u.string->len,e=0;e<size-1;e++)
{
pos=sp[-2].u.string->len - (ptrdiff_t)((e+1)*len+0.5);
a->item[size-1-e].u.string=string_slice(sp[-2].u.string,
pos,
last-pos);
a->item[size-1-e].type=T_STRING;
last=pos;
}
pos=0;
a->item[0].u.string=string_slice(sp[-2].u.string,
pos,
last-pos);
a->item[0].type=T_STRING;
}else{
size=(ptrdiff_t)ceil( ((double)sp[-2].u.string->len) / len); a=allocate_array(size);
for(last=0,e=0;e<size-1;e++)
{
pos = DO_NOT_WARN((ptrdiff_t)((e+1)*len+0.5));
a->item[e].u.string=string_slice(sp[-2].u.string,
last,
pos-last);
a->item[e].type=T_STRING;
last=pos;
}
pos=sp[-2].u.string->len;
a->item[e].u.string=string_slice(sp[-2].u.string,
last,
pos-last);
a->item[e].type=T_STRING;
}
a->type_field=BIT_STRING;
pop_n_elems(2);
push_array(a);
return;
}
case TWO_TYPES(T_ARRAY, T_INT):
{
struct array *a;
ptrdiff_t size,e,pos;
INT_TYPE len=sp[-1].u.integer;
if(!len)
OP_DIVISION_BY_ZERO_ERROR("`/");
if(len<0)
{
len = -len;
pos = sp[-2].u.array->size % len;
}else{
pos = 0;
}
size = sp[-2].u.array->size / len;
a=allocate_array(size);
for(e=0;e<size;e++)
{
a->item[e].u.array=friendly_slice_array(sp[-2].u.array,
pos,
pos+len);
pos+=len;
a->item[e].type=T_ARRAY;
}
a->type_field=BIT_ARRAY;
pop_n_elems(2);
push_array(a);
return;
}
case TWO_TYPES(T_ARRAY,T_FLOAT):
{
struct array *a;
ptrdiff_t last,pos,e,size;
FLOAT_ARG_TYPE len;
len=sp[-1].u.float_number;
if(len==0.0)
OP_DIVISION_BY_ZERO_ERROR("`/");
if(len<0)
{
len=-len; size = (ptrdiff_t)ceil( ((double)sp[-2].u.array->size) / len);
a=allocate_array(size);
for(last=sp[-2].u.array->size,e=0;e<size-1;e++)
{
pos=sp[-2].u.array->size - (ptrdiff_t)((e+1)*len+0.5);
a->item[size-1-e].u.array=friendly_slice_array(sp[-2].u.array,
pos,
last);
a->item[size-1-e].type=T_ARRAY;
last=pos;
}
a->item[0].u.array=slice_array(sp[-2].u.array,
0,
last);
a->item[0].type=T_ARRAY;
}else{
size = (ptrdiff_t)ceil( ((double)sp[-2].u.array->size) / len);
a=allocate_array(size);
for(last=0,e=0;e<size-1;e++)
{
pos = (ptrdiff_t)((e+1)*len+0.5);
a->item[e].u.array=friendly_slice_array(sp[-2].u.array,
last,
pos);
a->item[e].type=T_ARRAY;
last=pos;
}
a->item[e].u.array=slice_array(sp[-2].u.array,
last,
sp[-2].u.array->size);
a->item[e].type=T_ARRAY;
}
a->type_field=BIT_ARRAY;
pop_n_elems(2);
push_array(a);
return;
}
}
PIKE_ERROR("`/", "Division on different types.\n", sp, 2);
}
switch(sp[-2].type)
{
case T_OBJECT:
do_lfun_division:
CALL_OPERATOR(LFUN_DIVIDE,2);
break;
case T_STRING:
{
struct array *ret;
ret=explode(sp[-2].u.string,sp[-1].u.string);
free_string(sp[-2].u.string);
free_string(sp[-1].u.string);
sp[-2].type=T_ARRAY;
sp[-2].u.array=ret;
sp--;
return;
}
case T_ARRAY:
{
struct array *ret=explode_array(sp[-2].u.array, sp[-1].u.array);
pop_n_elems(2);
push_array(ret);
return;
}
case T_FLOAT:
if(sp[-1].u.float_number == 0.0)
OP_DIVISION_BY_ZERO_ERROR("`/");
sp--;
sp[-1].u.float_number /= sp[0].u.float_number;
return;
case T_INT:
{
INT_TYPE tmp;
if (sp[-1].u.integer == 0)
OP_DIVISION_BY_ZERO_ERROR("`/");
if(INT_TYPE_DIV_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer))
{
#ifdef AUTO_BIGNUM
stack_swap();
convert_stack_top_to_bignum();
stack_swap();
goto do_lfun_division;
#else
/* It's not possible to do MININT/-1 (it gives FPU exception on
some CPU:s), thus we return what MININT*-1 returns: MININT. */
tmp = sp[-2].u.integer;
#endif /* AUTO_BIGNUM */
}
else
tmp = sp[-2].u.integer/sp[-1].u.integer;
sp--;
/* What is this trying to solve? /Noring */
/* It fixes rounding towards negative infinity. /mast */
if((sp[-1].u.integer<0) != (sp[0].u.integer<0))
if(tmp*sp[0].u.integer!=sp[-1].u.integer)
tmp--;
sp[-1].u.integer=tmp;
return;
}
default:
PIKE_ERROR("`/", "Bad argument 1.\n", sp, 2);
}
}
/*! @decl mixed `/(object arg1, mixed arg2)
*! @decl mixed `/(mixed arg1, object arg2)
*! @decl array(string) `/(string arg1, int arg2)
*! @decl array(string) `/(string arg1, float arg2)
*! @decl array(array) `/(array arg1, int arg2)
*! @decl array(array) `/(array arg1, float arg2)
*! @decl array(string) `/(string arg1, string arg2)
*! @decl array(array) `/(array arg1, array arg2)
*! @decl float `/(float arg1, int|float arg2)
*! @decl float `/(int arg1, float arg2)
*! @decl int `/(int arg1, int arg2)
*! @decl mixed `/(mixed arg1, mixed arg2, mixed ... extras)
*!
*! Division/split.
*!
*! Every expression with the @expr{/@} operator becomes a call to
*! this function, i.e. @expr{a/b@} is the same as
*! @expr{predef::`/(a,b)@}.
*!
*! @returns
*! If there are more than two arguments, the result will be
*! @expr{`/(`/(@[arg1], @[arg2]), @@@[extras])@}.
*!
*! If @[arg1] is an object that implements @[lfun::`/()], that *! function will be called with @[arg2] as the single argument.
*!
*! If @[arg2] is an object that implements @[lfun::``/()], that
*! function will be called with @[arg1] as the single argument.
*!
*! Otherwise the result will be as follows:
*! @mixed arg1
*! @type string
*! @mixed arg2
*! @type int|float
*! The result will be and array of @[arg1] split in segments
*! of length @[arg2]. If @[arg2] is negative the splitting
*! will start from the end of @[arg1].
*! @type string
*! The result will be an array of @[arg1] split at each
*! occurrence of @[arg2]. Note that the segments that
*! matched against @[arg2] will not be in the result.
*! @endmixed
*! @type array
*! @mixed arg2
*! @type int|float
*! The result will be and array of @[arg1] split in segments
*! of length @[arg2]. If @[arg2] is negative the splitting
*! will start from the end of @[arg1].
*! @type array
*! The result will be an array of @[arg1] split at each
*! occurrence of @[arg2]. Note that the elements that
*! matched against @[arg2] will not be in the result.
*! @endmixed
*! @type float|int
*! The result will be @expr{@[arg1] / @[arg2]@}. If both arguments
*! are int, the result will be truncated to an int. Otherwise the
*! result will be a float.
*! @endmixed
*! @note
*! Unlike in some languages, the function f(x) = x/n (x and n integers)
*! behaves in a well-defined way and is always rounded down. When you
*! increase x, f(x) will increase with one for each n:th increment. For
*! all x, (x + n) / n = x/n + 1; crossing
*! zero is not special. This also means that / and % are compatible, so
*! that a = b*(a/b) + a%b for all a and b.
*! @seealso
*! @[`%]
*/
PMOD_EXPORT void f_divide(INT32 args)
{
switch(args)
{
case 0:
case 1: SIMPLE_TOO_FEW_ARGS_ERROR("`/", 2);
case 2: o_divide(); break;
default:
{
INT32 e;
struct svalue *s=sp-args;
push_svalue(s);
for(e=1;e<args;e++)
{
push_svalue(s+e);
o_divide();
}
assign_svalue(s,sp-1);
pop_n_elems(sp-s-1);
}
}
}
static int generate_divide(node *n)
{
if(count_args(CDR(n))==2) {
do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
emit0(F_DIVIDE);
return 1;
}
return 0;
}
PMOD_EXPORT void o_mod(void)
{
if(sp[-2].type != sp[-1].type && !float_promote())
{
if(call_lfun(LFUN_MOD, LFUN_RMOD))
return;
switch(TWO_TYPES(sp[-2].type,sp[-1].type))
{
case TWO_TYPES(T_STRING,T_INT):
{
struct pike_string *s=sp[-2].u.string;
ptrdiff_t tmp,base;
if(!sp[-1].u.integer)
OP_MODULO_BY_ZERO_ERROR("`%");
if(sp[-1].u.integer<0)
{
tmp=s->len % -sp[-1].u.integer;
base=0;
}else{
tmp=s->len % sp[-1].u.integer;
base=s->len - tmp;
}
s=string_slice(s, base, tmp);
pop_n_elems(2);
push_string(s);
return;
}
case TWO_TYPES(T_ARRAY,T_INT):
{
struct array *a=sp[-2].u.array;
ptrdiff_t tmp,base;
if(!sp[-1].u.integer)
OP_MODULO_BY_ZERO_ERROR("`%");
if(sp[-1].u.integer<0)
{
tmp=a->size % -sp[-1].u.integer;
base=0;
}else{
tmp=a->size % sp[-1].u.integer;
base=a->size - tmp;
}
a=slice_array(a,base,base+tmp);
pop_n_elems(2);
push_array(a);
return;
}
}
PIKE_ERROR("`%", "Modulo on different types.\n", sp, 2);
}
switch(sp[-2].type)
{
case T_OBJECT:
CALL_OPERATOR(LFUN_MOD,2); break;
case T_FLOAT:
{
FLOAT_TYPE foo;
if(sp[-1].u.float_number == 0.0)
OP_MODULO_BY_ZERO_ERROR("`%");
sp--;
foo = DO_NOT_WARN((FLOAT_TYPE)(sp[-1].u.float_number /
sp[0].u.float_number));
foo = DO_NOT_WARN((FLOAT_TYPE)(sp[-1].u.float_number -
sp[0].u.float_number * floor(foo)));
sp[-1].u.float_number=foo;
return;
}
case T_INT:
if (sp[-1].u.integer == 0)
OP_MODULO_BY_ZERO_ERROR("`%");
sp--;
if(sp[-1].u.integer>=0)
{
if(sp[0].u.integer>=0)
{
sp[-1].u.integer %= sp[0].u.integer;
}else{
sp[-1].u.integer=((sp[-1].u.integer+~sp[0].u.integer)%-sp[0].u.integer)-~sp[0].u.integer;
}
}else{
if(sp[0].u.integer>=0)
{
sp[-1].u.integer=sp[0].u.integer+~((~sp[-1].u.integer) % sp[0].u.integer);
}else{
sp[-1].u.integer=-(-sp[-1].u.integer % -sp[0].u.integer);
}
}
return;
default:
PIKE_ERROR("`%", "Bad argument 1.\n", sp, 2);
}
}
/*! @decl mixed `%(object arg1, mixed arg2)
*! @decl mixed `%(mixed arg1, object arg2)
*! @decl string `%(string arg1, int arg2)
*! @decl array `%(array arg1, int arg2)
*! @decl float `%(float arg1, float|int arg2)
*! @decl float `%(int arg1, float arg2)
*! @decl int `%(int arg1, int arg2)
*!
*! Modulo.
*!
*! Every expression with the @expr{%@} operator becomes a call to
*! this function, i.e. @expr{a%b@} is the same as
*! @expr{predef::`%(a,b)@}.
*!
*! @returns
*! If @[arg1] is an object that implements @[lfun::`%()] then
*! that function will be called with @[arg2] as the single argument.
*!
*! If @[arg2] is an object that implements @[lfun::``%()] then
*! that function will be called with @[arg2] as the single argument.
*!
*! Otherwise the result will be as follows:
*! @mixed arg1
*! @type string|array
*! If @[arg2] is positive, the result will be the last
*! @expr{`%(@[sizeof](@[arg1]), @[arg2])@} elements of @[arg1].
*! If @[arg2] is negative, the result will be the first
*! @expr{`%(@[sizeof](@[arg1]), -@[arg2])@} elements of @[arg1]. *! @type int|float
*! The result will be
*! @expr{@[arg1] - @[arg2]*@[floor](@[arg1]/@[arg2])@}.
*! The result will be a float if either @[arg1] or @[arg2] is
*! a float, and an int otherwise.
*! @endmixed
*!
*! For numbers, this means that
*! @ol
*! @item
*! a % b always has the same sign as b (typically b is positive;
*! array size, rsa modulo, etc, and a varies a lot more than b).
*! @item
*! The function f(x) = x % n behaves in a sane way; as x increases,
*! f(x) cycles through the values 0,1, ..., n-1, 0, .... Nothing
*! strange happens when you cross zero.
*! @item
*! The % operator implements the binary "mod" operation, as defined
*! by Donald Knuth (see the Art of Computer Programming, 1.2.4). It
*! should be noted that Pike treats %-by-0 as an error rather than
*! returning 0, though.
*! @item
*! / and % are compatible, so that a = b*(a/b) + a%b for all a and b.
*! @endol
*! @seealso
*! @[`/]
*/
PMOD_EXPORT void f_mod(INT32 args)
{
if(args != 2) {
/* FIXME: Not appropriate when too many args. */
SIMPLE_TOO_FEW_ARGS_ERROR("`%", 2);
}
o_mod();
}
static int generate_mod(node *n)
{
if(count_args(CDR(n))==2)
{
do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
emit0(F_MOD);
return 1;
}
return 0;
}
PMOD_EXPORT void o_not(void)
{
switch(sp[-1].type)
{
case T_INT:
sp[-1].u.integer = !sp[-1].u.integer;
break;
case T_FUNCTION:
case T_OBJECT:
if(UNSAFE_IS_ZERO(sp-1))
{
pop_stack();
push_int(1);
}else{
pop_stack();
push_int(0);
}
break;
default:
free_svalue(sp-1);
sp[-1].type=T_INT; sp[-1].u.integer=0;
}
}
/*! @decl int(0..1) `!(object|function arg)
*! @decl int(1..1) `!(int(0..0) arg)
*! @decl int(0..0) `!(mixed arg)
*!
*! Logical not.
*!
*! Every expression with the @expr{!@} operator becomes a call to
*! this function, i.e. @expr{!a@} is the same as
*! @expr{predef::`!(a)@}.
*!
*! It's also used when necessary to test truth on objects, i.e. in
*! a statement @expr{if (o) ...@} where @expr{o@} is an object, the
*! test becomes the equivalent of @expr{!!o@} so that any
*! @[lfun::`!()] the object might have gets called.
*!
*! @returns
*! If @[arg] is an object that implements @[lfun::`!()], that function
*! will be called.
*!
*! If @[arg] is @expr{0@} (zero), a destructed object, or a function in a
*! destructed object, @expr{1@} will be returned.
*!
*! Otherwise @expr{0@} (zero) will be returned.
*!
*! @note
*! No float is considered false, not even @expr{0.0@}.
*!
*! @seealso
*! @[`==()], @[`!=()], @[lfun::`!()]
*/
PMOD_EXPORT void f_not(INT32 args)
{
if(args != 1) {
/* FIXME: Not appropriate with too many args. */
SIMPLE_TOO_FEW_ARGS_ERROR("`!", 1);
}
o_not();
}
static int generate_not(node *n)
{
if(count_args(CDR(n))==1)
{
do_docode(CDR(n),DO_NOT_COPY);
emit0(F_NOT);
return 1;
}
return 0;
}
PMOD_EXPORT void o_compl(void)
{
switch(sp[-1].type)
{
case T_OBJECT:
CALL_OPERATOR(LFUN_COMPL,1);
break;
case T_INT:
sp[-1].u.integer = ~ sp[-1].u.integer;
break;
case T_FLOAT:
sp[-1].u.float_number = -1.0 - sp[-1].u.float_number;
break;
case T_TYPE:
type_stack_mark();
if (sp[-1].u.type->type == T_NOT) {
push_finished_type(sp[-1].u.type->car);
} else {
push_finished_type(sp[-1].u.type);
push_type(T_NOT);
}
pop_stack();
push_type_value(pop_unfinished_type());
break;
case T_FUNCTION:
case T_PROGRAM:
{
/* !object(p) */
struct program *p = program_from_svalue(sp - 1);
if (!p) {
PIKE_ERROR("`~", "Bad argument.\n", sp, 1);
}
type_stack_mark();
push_object_type(0, p->id);
push_type(T_NOT);
pop_stack();
push_type_value(pop_unfinished_type());
}
break;
case T_STRING:
{
struct pike_string *s;
ptrdiff_t len, i;
if(sp[-1].u.string->size_shift) {
bad_arg_error("`~", sp-1, 1, 1, "string(0)", sp-1,
"Expected 8-bit string.\n");
}
len = sp[-1].u.string->len;
s = begin_shared_string(len);
for (i=0; i<len; i++)
s->str[i] = ~ sp[-1].u.string->str[i];
pop_n_elems(1);
push_string(end_shared_string(s));
break;
}
default:
PIKE_ERROR("`~", "Bad argument.\n", sp, 1);
}
}
/*! @decl mixed `~(object arg)
*! @decl int `~(int arg)
*! @decl float `~(float arg)
*! @decl type `~(type|program arg)
*! @decl string `~(string arg)
*!
*! Complement/inversion.
*!
*! Every expression with the @expr{~@} operator becomes a call to
*! this function, i.e. @expr{~a@} is the same as
*! @expr{predef::`~(a)@}.
*!
*! @returns
*! The result will be as follows:
*! @mixed arg
*! @type object
*! If @[arg] implements @[lfun::`~()], that function will be called.
*! @type int *! The bitwise inverse of @[arg] will be returned.
*! @type float
*! The result will be @expr{-1.0 - @[arg]@}.
*! @type type|program
*! The type inverse of @[arg] will be returned.
*! @type string
*! If @[arg] only contains characters in the range 0 - 255 (8-bit),
*! a string containing the corresponding 8-bit inverses will be
*! returned.
*! @endmixed
*!
*! @seealso
*! @[`!()], @[lfun::`~()]
*/
PMOD_EXPORT void f_compl(INT32 args)
{
if(args != 1) {
/* FIXME: Not appropriate with too many args. */
SIMPLE_TOO_FEW_ARGS_ERROR("`~", 1);
}
o_compl();
}
static int generate_compl(node *n)
{
if(count_args(CDR(n))==1)
{
do_docode(CDR(n),DO_NOT_COPY);
emit0(F_COMPL);
return 1;
}
return 0;
}
PMOD_EXPORT void o_negate(void)
{
switch(sp[-1].type)
{
case T_OBJECT:
do_lfun_negate:
CALL_OPERATOR(LFUN_SUBTRACT,1);
break;
case T_FLOAT:
sp[-1].u.float_number=-sp[-1].u.float_number;
return;
case T_INT:
#ifdef AUTO_BIGNUM
if(INT_TYPE_NEG_OVERFLOW(sp[-1].u.integer))
{
convert_stack_top_to_bignum();
goto do_lfun_negate;
}
#endif /* AUTO_BIGNUM */
sp[-1].u.integer = - sp[-1].u.integer;
return;
default:
PIKE_ERROR("`-", "Bad argument to unary minus.\n", sp, 1);
}
}
PMOD_EXPORT void o_range(void)
{
INT_TYPE from, to;
if(sp[-3].type==T_OBJECT)
{
CALL_OPERATOR(LFUN_INDEX, 3); return;
}
if(sp[-2].type != T_INT)
PIKE_ERROR("`[]", "Bad argument 2 to [ .. ]\n", sp, 3);
if(sp[-1].type != T_INT)
PIKE_ERROR("`[]", "Bad argument 3 to [ .. ]\n", sp, 3);
from = sp[-2].u.integer;
if(from<0) from = 0;
to = sp[-1].u.integer;
if(to<from-1) to = from-1;
dmalloc_touch_svalue(Pike_sp-1);
dmalloc_touch_svalue(Pike_sp-2);
sp-=2;
switch(sp[-1].type)
{
case T_STRING:
{
struct pike_string *s;
if(to >= sp[-1].u.string->len-1)
{
if(from==0) return;
to = sp[-1].u.string->len-1;
if(from>to+1) from=to+1;
}
#ifdef PIKE_DEBUG
if(from < 0 || (to-from+1) < 0)
Pike_fatal("Error in o_range.\n");
#endif
s=string_slice(sp[-1].u.string, from, to-from+1);
free_string(sp[-1].u.string);
sp[-1].u.string=s;
break;
}
case T_ARRAY:
{
struct array *a;
if(to >= sp[-1].u.array->size-1)
{
to = sp[-1].u.array->size-1;
if(from>to+1) from=to+1;
}
a = slice_array(sp[-1].u.array, from, to+1);
free_array(sp[-1].u.array);
sp[-1].u.array=a;
break;
}
default:
PIKE_ERROR("`[]", "[ .. ] on non-scalar type.\n", sp, 3);
}
}
/*! @decl mixed `[](object arg, mixed index)
*! @decl mixed `[](object arg, string index)
*! @decl mixed `[](int arg, string index)
*! @decl mixed `[](array arg, int index)
*! @decl mixed `[](array arg, mixed index)
*! @decl mixed `[](mapping arg, mixed index)
*! @decl int(0..1) `[](multiset arg, mixed index)
*! @decl int `[](string arg, int index)
*! @decl mixed `[](program arg, string index) *! @decl mixed `[](object arg, mixed start, mixed end)
*! @decl string `[](string arg, int start, int end)
*! @decl array `[](array arg, int start, int end)
*!
*! Index/subrange.
*!
*! Every non-lvalue expression with the @expr{[]@} operator becomes
*! a call to this function, i.e. @expr{a[i]@} is the same as
*! @expr{predef::`[](a,i)@} and @expr{a[i..j]@} is the same as
*! @expr{predef::`[](a,i,j)@}. If the lower limit @expr{i@} is left
*! out, @expr{0@} is passed to the function. If the upper limit
*! @expr{j@} is left out, @[Int.NATIVE_MAX] is passed to the
*! function, but that might be changed to an even larger number in
*! the future.
*!
*! @returns
*! If @[arg] is an object that implements @[lfun::`[]()], that function
*! will be called with the rest of the arguments.
*!
*! If there are 2 arguments the result will be as follows:
*! @mixed arg
*! @type object
*! The non-static (ie public) symbol named @[index] will be looked up
*! in @[arg].
*! @type int
*! The bignum function named @[index] will be looked up in @[arg].
*! @type array
*! If @[index] is an int, index number @[index] of @[arg] will be
*! returned. Otherwise an array of all elements in @[arg] indexed
*! with @[index] will be returned.
*! @type mapping
*! If @[index] exists in @[arg] the corresponding value will be
*! returned. Otherwise @expr{UNDEFINED@} will be returned.
*! @type multiset
*! If @[index] exists in @[arg], @expr{1@} will be returned.
*! Otherwise @expr{UNDEFINED@} will be returned.
*! @type string
*! The character (int) at index @[index] in @[arg] will be returned.
*! @type program
*! The non-static (ie public) constant symbol @[index] will be
*! looked up in @[arg].
*! @endmixed
*!
*! Otherwise if there are 3 arguments the result will be as follows:
*! @mixed arg
*! @type string
*! A string with the characters between @[start] and @[end] (inclusive)
*! in @[arg] will be returned.
*! @type array
*! An array with the elements between @[start] and @[end] (inclusive)
*! in @[arg] will be returned.
*! @endmixed
*!
*! @note
*! An indexing expression in an lvalue context, i.e. where the
*! index is being assigned a new value, uses @[`[]=] instead of
*! this function.
*!
*! @seealso
*! @[`->()], @[lfun::`[]()], @[`[]=]
*/
PMOD_EXPORT void f_index(INT32 args)
{
switch(args)
{
case 0:
case 1:
PIKE_ERROR("`[]", "Too few arguments.\n", sp, args);
break;
case 2: if(sp[-1].type==T_STRING) sp[-1].subtype=0;
o_index();
break;
case 3:
o_range();
break;
default:
PIKE_ERROR("`[]", "Too many arguments.\n", sp, args);
}
}
/*! @decl mixed `->(object arg, string index)
*! @decl mixed `->(int arg, string index)
*! @decl mixed `->(array arg, string index)
*! @decl mixed `->(mapping arg, string index)
*! @decl int(0..1) `->(multiset arg, string index)
*! @decl mixed `->(program arg, string index)
*!
*! Arrow index.
*!
*! Every non-lvalue expression with the @expr{->@} operator becomes
*! a call to this function. @expr{a->b@} is the same as
*! @expr{predef::`^(a,"b")@} where @expr{"b"@} is the symbol
*! @expr{b@} in string form.
*!
*! This function behaves like @[`[]], except that the index is
*! passed literally as a string instead of being evaluated.
*!
*! @returns
*! If @[arg] is an object that implements @[lfun::`->()], that function
*! will be called with @[index] as the single argument.
*!
*! Otherwise the result will be as follows:
*! @mixed arg
*! @type object
*! The non-static (ie public) symbol named @[index] will be looked up
*! in @[arg].
*! @type int
*! The bignum function named @[index] will be looked up in @[arg].
*! @type array
*! An array of all elements in @[arg] arrow indexed with @[index]
*! will be returned.
*! @type mapping
*! If @[index] exists in @[arg] the corresponding value will be
*! returned. Otherwise @expr{UNDEFINED@} will be returned.
*! @type multiset
*! If @[index] exists in @[arg], @expr{1@} will be returned.
*! Otherwise @expr{UNDEFINED@} will be returned.
*! @type program
*! The non-static (ie public) constant symbol @[index] will be
*! looked up in @[arg].
*! @endmixed
*!
*! @note
*! In an expression @expr{a->b@}, the symbol @expr{b@} can be any
*! token that matches the identifier syntax - keywords are
*! disregarded in that context.
*!
*! @note
*! An arrow indexing expression in an lvalue context, i.e. where
*! the index is being assigned a new value, uses @[`->=] instead of
*! this function.
*!
*! @seealso
*! @[`[]()], @[lfun::`->()], @[::`->()], @[`->=]
*/
PMOD_EXPORT void f_arrow(INT32 args)
{
switch(args)
{ case 0:
case 1:
PIKE_ERROR("`->", "Too few arguments.\n", sp, args);
break;
case 2:
if(sp[-1].type==T_STRING)
sp[-1].subtype=1;
o_index();
break;
default:
PIKE_ERROR("`->", "Too many arguments.\n", sp, args);
}
}
/*! @decl mixed `[]=(object arg, mixed index, mixed val)
*! @decl mixed `[]=(object arg, string index, mixed val)
*! @decl mixed `[]=(array arg, int index, mixed val)
*! @decl mixed `[]=(mapping arg, mixed index, mixed val)
*! @decl int(0..1) `[]=(multiset arg, mixed index, int(0..1) val)
*!
*! Index assignment.
*!
*! Every lvalue expression with the @expr{[]@} operator becomes a
*! call to this function, i.e. @expr{a[b]=c@} is the same as
*! @expr{predef::`[]=(a,b,c)@}.
*!
*! If @[arg] is an object that implements @[lfun::`[]=()], that function
*! will be called with @[index] and @[val] as the arguments.
*!
*! @mixed arg
*! @type object
*! The non-static (ie public) variable named @[index] will be looked up
*! in @[arg], and assigned @[val].
*! @type array|mapping
*! Index @[index] in @[arg] will be assigned @[val].
*! @type multiset
*! If @[val] is @expr{0@} (zero), one occurrance of @[index] in
*! @[arg] will be removed. Otherwise @[index] will be added
*! to @[arg] if it is not already there.
*! @endmixed
*!
*! @returns
*! @[val] will be returned.
*!
*! @note
*! An indexing expression in a non-lvalue context, i.e. where the
*! index is being queried instead of assigned, uses @[`[]] instead
*! of this function.
*!
*! @seealso
*! @[`->=()], @[lfun::`[]=()], @[`[]]
*/
PMOD_EXPORT void f_index_assign(INT32 args)
{
switch (args) {
case 0:
case 1:
case 2:
PIKE_ERROR("`[]=", "Too few arguments.\n", sp, args);
break;
case 3:
if(sp[-2].type==T_STRING) sp[-2].subtype=0;
assign_lvalue (sp-3, sp-1);
assign_svalue (sp-3, sp-1);
pop_n_elems (args-1);
break;
default:
PIKE_ERROR("`[]=", "Too many arguments.\n", sp, args);
}
}
/*! @decl mixed `->=(object arg, string index, mixed val)
*! @decl mixed `->=(mapping arg, string index, mixed val)
*! @decl int(0..1) `->=(multiset arg, string index, int(0..1) val)
*!
*! Arrow index assignment.
*!
*! Every lvalue expression with the @expr{->@} operator becomes a
*! call to this function, i.e. @expr{a->b=c@} is the same as
*! @expr{predef::`->=(a,"b",c)@} where @expr{"b"@} is the symbol
*! @expr{b@} in string form.
*!
*! This function behaves like @[`[]=], except that the index is
*! passed literally as a string instead of being evaluated.
*!
*! If @[arg] is an object that implements @[lfun::`->=()], that function
*! will be called with @[index] and @[val] as the arguments.
*!
*! @mixed arg
*! @type object
*! The non-static (ie public) variable named @[index] will be looked up
*! in @[arg], and assigned @[val].
*! @type array|mapping
*! Index @[index] in @[arg] will be assigned @[val].
*! @type multiset
*! If @[val] is @expr{0@} (zero), one occurrance of @[index] in
*! @[arg] will be removed. Otherwise @[index] will be added
*! to @[arg] if it is not already there.
*! @endmixed
*!
*! @returns
*! @[val] will be returned.
*!
*! @note
*! In an expression @expr{a->b=c@}, the symbol @expr{b@} can be any
*! token that matches the identifier syntax - keywords are
*! disregarded in that context.
*!
*! @note
*! An arrow indexing expression in a non-lvalue context, i.e. where
*! the index is being queried instead of assigned, uses @[`->]
*! instead of this function.
*!
*! @seealso
*! @[`[]=()], @[lfun::`->=()], @[`->]
*/
PMOD_EXPORT void f_arrow_assign(INT32 args)
{
switch (args) {
case 0:
case 1:
case 2:
PIKE_ERROR("`->=", "Too few arguments.\n", sp, args);
break;
case 3:
if(sp[-2].type==T_STRING) sp[-2].subtype=1;
assign_lvalue (sp-3, sp-1);
assign_svalue (sp-3, sp-1);
pop_n_elems (args-1);
break;
default:
PIKE_ERROR("`->=", "Too many arguments.\n", sp, args);
}
}
/*! @decl int sizeof(string arg)
*! @decl int sizeof(array arg)
*! @decl int sizeof(mapping arg)
*! @decl int sizeof(multiset arg)
*! @decl int sizeof(object arg) *!
*! Size query.
*!
*! @returns
*! The result will be as follows:
*! @mixed arg
*! @type string
*! The number of characters in @[arg] will be returned.
*! @type array|multiset
*! The number of elements in @[arg] will be returned.
*! @type mapping
*! The number of key-value pairs in @[arg] will be returned.
*! @type object
*! If @[arg] implements @[lfun::_sizeof()], that function will
*! be called. Otherwise the number of non-static (ie public)
*! symbols in @[arg] will be returned.
*! @endmixed
*!
*! @seealso
*! @[lfun::_sizeof()]
*/
PMOD_EXPORT void f_sizeof(INT32 args)
{
INT32 tmp;
if(args<1)
PIKE_ERROR("sizeof", "Too few arguments.\n", sp, args);
tmp=pike_sizeof(sp-args);
pop_n_elems(args);
push_int(tmp);
}
static node *optimize_sizeof(node *n)
{
if (CDR(n) && (CDR(n)->token == F_APPLY) &&
(CADR(n)) && (CADR(n)->token == F_CONSTANT) &&
(CADR(n)->u.sval.type == T_FUNCTION) &&
(CADR(n)->u.sval.subtype == FUNCTION_BUILTIN)) {
extern struct program *string_split_iterator_program;
/* sizeof(efun(...)) */
if ((CADR(n)->u.sval.u.efun->function == f_divide) &&
CDDR(n) && (CDDR(n)->token == F_ARG_LIST) &&
CADDR(n) && (CADDR(n)->type == string_type_string) &&
CDDDR(n) && (CDDDR(n)->token == F_CONSTANT) &&
(CDDDR(n)->u.sval.type == T_STRING) &&
(CDDDR(n)->u.sval.u.string->len == 1)) {
p_wchar2 split = index_shared_string(CDDDR(n)->u.sval.u.string, 0);
/* sizeof(`/(str, "x")) */
ADD_NODE_REF2(CADDR(n),
return mkefuncallnode("sizeof",
mkapplynode(mkprgnode(string_split_iterator_program),
mknode(F_ARG_LIST, CADDR(n),
mkintnode(split))));
);
}
if ((CADR(n)->u.sval.u.efun->function == f_minus) &&
CDDR(n) && (CDDR(n)->token == F_ARG_LIST) &&
CADDR(n) && (CADDR(n)->token == F_APPLY) &&
CAADDR(n) && (CAADDR(n)->token == F_CONSTANT) &&
(CAADDR(n)->u.sval.type == T_FUNCTION) &&
(CAADDR(n)->u.sval.subtype == FUNCTION_BUILTIN) &&
(CAADDR(n)->u.sval.u.efun->function == f_divide) &&
CDADDR(n) && (CDADDR(n)->token == F_ARG_LIST) &&
CADADDR(n) && (CADADDR(n)->type == string_type_string) &&
CDDADDR(n) && (CDDADDR(n)->token == F_CONSTANT) &&
(CDDADDR(n)->u.sval.type == T_STRING) &&
(CDDADDR(n)->u.sval.u.string->len == 1) &&
CDDDR(n)) { /* sizeof(`-(`/(str, "x"), y)) */
if (((CDDDR(n)->token == F_CONSTANT) &&
(CDDDR(n)->u.sval.type == T_ARRAY) &&
(CDDDR(n)->u.sval.u.array->size == 1) &&
(CDDDR(n)->u.sval.u.array->item[0].type == T_STRING) &&
(CDDDR(n)->u.sval.u.array->item[0].u.string->len == 0)) ||
((CDDDR(n)->token == F_APPLY) &&
CADDDR(n) && (CADDDR(n)->token == F_CONSTANT) &&
(CADDDR(n)->u.sval.type == T_FUNCTION) &&
(CADDDR(n)->u.sval.subtype == FUNCTION_BUILTIN) &&
(CADDDR(n)->u.sval.u.efun->function == f_allocate) &&
CDDDDR(n) && (CDDDDR(n)->token == F_ARG_LIST) &&
CADDDDR(n) && (CADDDDR(n)->token == F_CONSTANT) &&
(CADDDDR(n)->u.sval.type == T_INT) &&
(CADDDDR(n)->u.sval.u.integer == 1) &&
CDDDDDR(n) && (CDDDDDR(n)->token == F_CONSTANT) &&
(CDDDDDR(n)->u.sval.type == T_STRING) &&
(CDDDDDR(n)->u.sval.u.string->len == 0))) {
/* sizeof(`-(`/(str, "x"), ({""}))) */
p_wchar2 split = index_shared_string(CDDADDR(n)->u.sval.u.string, 0);
ADD_NODE_REF2(CADADDR(n),
return mkefuncallnode("sizeof",
mkapplynode(mkprgnode(string_split_iterator_program),
mknode(F_ARG_LIST, CADADDR(n),
mknode(F_ARG_LIST,
mkintnode(split),
mkintnode(1)))));
);
}
}
}
return NULL;
}
static int generate_sizeof(node *n)
{
if(count_args(CDR(n)) != 1) return 0;
if(do_docode(CDR(n),DO_NOT_COPY) != 1)
Pike_fatal("Count args was wrong in sizeof().\n");
emit0(F_SIZEOF);
return 1;
}
extern int generate_call_function(node *n);
/*! @class string_assignment
*/
struct program *string_assignment_program;
#undef THIS
#define THIS ((struct string_assignment_storage *)(CURRENT_STORAGE))
/*! @decl int `[](int i, int j)
*!
*! String index operator.
*/
static void f_string_assignment_index(INT32 args)
{
ptrdiff_t len = THIS->s->len;
INT_TYPE i, p;
get_all_args("string[]",args,"%i",&p);
i = p < 0 ? p + len : p;
if(i<0 || i>=len)
Pike_error("Index %"PRINTPIKEINT"d is out of string range "
"%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n",
p, -len, len - 1);
else
i=index_shared_string(THIS->s,i);
pop_n_elems(args);
push_int(i);}
/*! @decl int `[]=(int i, int j)
*!
*! String assign index operator.
*/
static void f_string_assignment_assign_index(INT32 args)
{
INT_TYPE p, i, j;
union anything *u;
ptrdiff_t len;
get_all_args("string[]=",args,"%i%i",&p,&j);
if((u=get_pointer_if_this_type(THIS->lval, T_STRING)))
{
len = u->string->len;
i = p < 0 ? p + len : p;
if(i<0 || i>=len)
Pike_error("Index %"PRINTPIKEINT"d is out of string range "
"%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n",
p, -len, len - 1);
free_string(THIS->s);
u->string=modify_shared_string(u->string,i,j);
copy_shared_string(THIS->s, u->string);
}
else{
lvalue_to_svalue_no_free(sp,THIS->lval);
sp++;
dmalloc_touch_svalue(Pike_sp-1);
if(sp[-1].type != T_STRING) Pike_error("string[]= failed.\n");
len = sp[-1].u.string->len;
i = p < 0 ? p + len : p;
if(i<0 || i>=len)
Pike_error("Index %"PRINTPIKEINT"d is out of string range "
"%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n",
p, -len, len - 1);
sp[-1].u.string=modify_shared_string(sp[-1].u.string,i,j);
assign_lvalue(THIS->lval, sp-1);
pop_stack();
}
pop_n_elems(args);
push_int(j);
}
static void init_string_assignment_storage(struct object *o)
{
THIS->lval[0].type=T_INT;
THIS->lval[1].type=T_INT;
THIS->s=0;
}
static void exit_string_assignment_storage(struct object *o)
{
free_svalues(THIS->lval, 2, BIT_MIXED);
if(THIS->s)
free_string(THIS->s);
}
/*! @endclass
*/
void init_operators(void)
{
/* function(string,int:int)|function(object,string:mixed)|function(array(0=mixed),int:0)|function(mapping(mixed:1=mixed),mixed:1)|function(multiset,mixed:int)|function(string,int,int:string)|function(array(2=mixed),int,int:array(2))|function(program:mixed) */
ADD_EFUN2("`[]",f_index,tOr7(tFunc(tStr tInt,tInt),tFunc(tObj tStr,tMix),tFunc(tArr(tSetvar(0,tMix)) tInt,tVar(0)),tFunc(tMap(tMix,tSetvar(1,tMix)) tMix,tVar(1)),tFunc(tMultiset tMix,tInt),tFunc(tStr tInt tInt,tStr),tOr(tFunc(tArr(tSetvar(2,tMix)) tInt tInt,tArr(tVar(2))),tFunc(tPrg(tObj),tMix))),OPT_TRY_OPTIMIZE,0,0);
/* function(array(object|mapping|multiset|array),string:array(mixed))|function(object|mapping|multiset|program,string:mixed) */
ADD_EFUN2("`->",f_arrow,tOr(tFunc(tArr(tOr4(tObj,tMapping,tMultiset,tArray)) tStr,tArr(tMix)),tFunc(tOr4(tObj,tMapping,tMultiset,tPrg(tObj)) tStr,tMix)),OPT_TRY_OPTIMIZE,0,0);
ADD_EFUN("`[]=", f_index_assign,
tOr4(tFunc(tObj tStr tSetvar(0,tMix), tVar(0)),
tFunc(tArr(tSetvar(1,tMix)) tInt tVar(1), tVar(1)),
tFunc(tMap(tSetvar(2,tMix), tSetvar(3,tMix)) tVar(2) tVar(3), tVar(3)),
tFunc(tSet(tSetvar(4,tMix)) tVar(4) tSetvar(5,tMix), tVar(5))),
OPT_SIDE_EFFECT|OPT_TRY_OPTIMIZE);
ADD_EFUN("`->=", f_arrow_assign,
tOr3(tFunc(tArr(tOr4(tArray,tObj,tMultiset,tMapping)) tStr tSetvar(0,tMix), tVar(0)),
tFunc(tOr(tObj, tMultiset) tStr tSetvar(1,tMix), tVar(1)),
tFunc(tMap(tMix, tSetvar(2,tMix)) tStr tVar(2), tVar(2))),
OPT_SIDE_EFFECT|OPT_TRY_OPTIMIZE);
/* function(mixed...:int) */
ADD_EFUN2("`==",f_eq,
tOr5(tFuncV(tOr(tInt,tFloat) tOr(tInt,tFloat),
tOr(tInt,tFloat),tInt01),
tFuncV(tSetvar(0,tOr4(tString,tMapping,tMultiset,tArray))
tVar(0), tVar(0),tInt01),
tFuncV(tOr3(tObj,tPrg(tObj),tFunction) tMix,tMix,tInt01),
tFuncV(tMix tOr3(tObj,tPrg(tObj),tFunction),tMix,tInt01),
tFuncV(tType(tMix) tType(tMix),
tOr3(tPrg(tObj),tFunction,tType(tMix)),tInt01)),
OPT_WEAK_TYPE|OPT_TRY_OPTIMIZE,optimize_eq,generate_comparison);
/* function(mixed...:int) */
ADD_EFUN2("`!=",f_ne,
tOr5(tFuncV(tOr(tInt,tFloat) tOr(tInt,tFloat),
tOr(tInt,tFloat),tInt01),
tFuncV(tSetvar(0,tOr4(tString,tMapping,tMultiset,tArray))
tVar(0), tVar(0),tInt01),
tFuncV(tOr3(tObj,tPrg(tObj),tFunction) tMix,tMix,tInt01),
tFuncV(tMix tOr3(tObj,tPrg(tObj),tFunction),tMix,tInt01),
tFuncV(tType(tMix) tType(tMix),
tOr3(tPrg(tObj),tFunction,tType(tMix)),tInt01)),
OPT_WEAK_TYPE|OPT_TRY_OPTIMIZE,0,generate_comparison);
/* function(mixed:int) */
ADD_EFUN2("`!",f_not,tFuncV(tMix,tVoid,tInt01),
OPT_TRY_OPTIMIZE,optimize_not,generate_not);
#define CMP_TYPE "!function(!(object|mixed)...:mixed)&function(mixed...:int(0..1))|function(int|float...:int(0..1))|function(string...:int(0..1))|function(type|program,type|program,type|program...:int(0..1))"
add_efun2("`<", f_lt,CMP_TYPE,OPT_TRY_OPTIMIZE,0,generate_comparison);
add_efun2("`<=",f_le,CMP_TYPE,OPT_TRY_OPTIMIZE,0,generate_comparison);
add_efun2("`>", f_gt,CMP_TYPE,OPT_TRY_OPTIMIZE,0,generate_comparison);
add_efun2("`>=",f_ge,CMP_TYPE,OPT_TRY_OPTIMIZE,0,generate_comparison);
ADD_EFUN2("`+",f_add,
tOr7(tIfnot(tFuncV(tNone,tNot(tOr(tObj,tMix)),tMix),tFunction),
tFuncV(tInt,tInt,tInt),
tIfnot(tFuncV(tNone, tNot(tFlt), tMix),
tFuncV(tOr(tInt,tFlt),tOr(tInt,tFlt),tFlt)),
tIfnot(tFuncV(tNone, tNot(tStr), tMix),
tFuncV(tOr3(tStr,tInt,tFlt),
tOr3(tStr,tInt,tFlt),tStr)),
tFuncV(tSetvar(0,tArray),tSetvar(1,tArray),
tOr(tVar(0),tVar(1))),
tFuncV(tSetvar(0,tMapping),tSetvar(1,tMapping),
tOr(tVar(0),tVar(1))),
tFuncV(tSetvar(0,tMultiset),tSetvar(1,tMultiset),
tOr(tVar(0),tVar(1)))),
OPT_TRY_OPTIMIZE,optimize_binary,generate_sum);
ADD_EFUN2("`-",f_minus,
tOr7(tIfnot(tFuncV(tNone,tNot(tOr(tObj,tMix)),tMix),tFunction),
tFuncV(tInt,tInt,tInt),
tIfnot(tFuncV(tNone,tNot(tFlt),tMix),
tFuncV(tOr(tInt,tFlt),tOr(tInt,tFlt),tFlt)),
tFuncV(tArr(tSetvar(0,tMix)),tArray,tArr(tVar(0))), tFuncV(tMap(tSetvar(1,tMix),tSetvar(2,tMix)),
tOr3(tMapping,tArray,tMultiset),
tMap(tVar(1),tVar(2))),
tFunc(tSet(tSetvar(3,tMix)) tMultiset,tSet(tVar(3))),
tFuncV(tStr,tStr,tStr)),
OPT_TRY_OPTIMIZE,0,generate_minus);
/*
object & mixed -> mixed
mixed & object -> mixed
int & int -> int
array & array -> array
multiset & multiset -> multiset
mapping & mapping -> mapping
string & string -> string
type|program & type|program -> type|program
mapping & array -> mapping
array & mapping -> mapping
mapping & multiset -> mapping
multiset & mapping -> mapping
*/
#define F_AND_TYPE(Z) \
tOr(tFunc(tSetvar(0,Z),tVar(0)), \
tIfnot(tFunc(Z,tMix), \
tFuncV(tSetvar(1,Z),tSetvar(2,Z), \
tOr(tVar(1),tVar(2)))))
ADD_EFUN2("`&",f_and,
tOr4(
tFunc(tSetvar(0,tMix),tVar(0)),
tOr(tFuncV(tMix tObj,tMix,tMix),
tFuncV(tObj tMix,tMix,tMix)),
tOr6( F_AND_TYPE(tInt),
F_AND_TYPE(tArray),
F_AND_TYPE(tMapping),
F_AND_TYPE(tMultiset),
F_AND_TYPE(tString),
F_AND_TYPE(tOr(tType(tMix),tPrg(tObj))) ),
tIfnot(tFuncV(tNone, tNot(tMapping), tMix),
tFuncV(tNone,
tOr3(tArray,tMultiset,tSetvar(4,tMapping)),
tVar(4)) )
),
OPT_TRY_OPTIMIZE,optimize_binary,generate_and);
#define LOG_TYPE \
tOr7(tOr(tFuncV(tMix tObj,tMix,tMix), \
tFuncV(tObj,tMix,tMix)), \
tFuncV(tInt,tInt,tInt), \
tFuncV(tSetvar(1,tMapping),tSetvar(2,tMapping),tOr(tVar(1),tVar(2))), \
tFuncV(tSetvar(3,tMultiset),tSetvar(4,tMultiset),tOr(tVar(3),tVar(4))), \
tFuncV(tSetvar(5,tArray),tSetvar(6,tArray),tOr(tVar(5),tVar(6))), \
tFuncV(tString,tString,tString), \
tFuncV(tOr(tType(tMix),tPrg(tObj)),tOr(tType(tMix),tPrg(tObj)),tType(tMix)))
ADD_EFUN2("`|",f_or,LOG_TYPE,OPT_TRY_OPTIMIZE,optimize_binary,generate_or);
ADD_EFUN2("`^",f_xor,LOG_TYPE,OPT_TRY_OPTIMIZE,optimize_binary,generate_xor);
#define SHIFT_TYPE \
tOr(tAnd(tNot(tFuncV(tNone, tNot(tObj), tMix)), \
tOr(tFunc(tMix tObj,tMix), \
tFunc(tObj tMix,tMix))), \
tFunc(tInt tInt,tInt))
ADD_EFUN2("`<<", f_lsh, SHIFT_TYPE, OPT_TRY_OPTIMIZE,
may_have_side_effects, generate_lsh);
ADD_EFUN2("`>>", f_rsh, SHIFT_TYPE, OPT_TRY_OPTIMIZE,
may_have_side_effects, generate_rsh);
/* !function(!object...:mixed)&function(mixed...:mixed)|"
"function(array(array(1=mixed)),array(1=mixed):array(1))|"
"function(int...:int)|"
"!function(int...:mixed)&function(float|int...:float)|"
"function(string*,string:string)|"
"function(array(0=mixed),int:array(0))|"
"function(array(0=mixed),float:array(0))|"
"function(string,int:string)
"function(string,float:string)
*/
ADD_EFUN2("`*", f_multiply,
tOr9(tIfnot(tFuncV(tNone,tNot(tOr(tObj,tMix)),tMix),tFunction),
tFunc(tArr(tArr(tSetvar(1,tMix)))
tArr(tSetvar(1,tMix)),tArr(tVar(1))),
tFuncV(tInt,tInt,tInt),
tIfnot(tFuncV(tNone,tNot(tFlt),tMix),
tFuncV(tOr(tFlt,tInt),tOr(tFlt,tInt),tFlt)),
tFunc(tArr(tStr) tStr,tStr),
tFunc(tArr(tSetvar(0,tMix)) tInt,tArr(tVar(0))),
tFunc(tArr(tSetvar(0,tMix)) tFlt,tArr(tVar(0))),
tFunc(tStr tInt,tStr),
tFunc(tStr tFlt,tStr)),
OPT_TRY_OPTIMIZE,optimize_binary,generate_multiply);
/* !function(!object...:mixed)&function(mixed...:mixed)|"
"function(int,int...:int)|"
"!function(int...:mixed)&function(float|int...:float)|"
"function(array(0=mixed),array|int|float...:array(array(0)))|"
"function(string,string|int|float...:array(string)) */
ADD_EFUN2("`/", f_divide,
tOr5(tIfnot(tFuncV(tNone,tNot(tOr(tObj,tMix)),tMix),tFunction),
tFuncV(tInt, tInt, tInt),
tIfnot(tFuncV(tNone, tNot(tFlt), tMix),
tFuncV(tOr(tFlt,tInt),tOr(tFlt,tInt),tFlt)),
tFuncV(tArr(tSetvar(0,tMix)),
tOr3(tArray,tInt,tFlt),
tArr(tArr(tVar(0)))),
tFuncV(tStr,tOr3(tStr,tInt,tFlt),tArr(tStr))),
OPT_TRY_OPTIMIZE,0,generate_divide);
/* function(mixed,object:mixed)|"
"function(object,mixed:mixed)|"
"function(int,int:int)|"
"function(string,int:string)|"
"function(array(0=mixed),int:array(0))|"
"!function(int,int:mixed)&function(int|float,int|float:float) */
ADD_EFUN2("`%", f_mod,
tOr6(tFunc(tMix tObj,tMix),
tFunc(tObj tMix,tMix),
tFunc(tInt tInt,tInt),
tFunc(tStr tInt,tStr),
tFunc(tArr(tSetvar(0,tMix)) tInt,tArr(tVar(0))),
tIfnot(tFuncV(tNone, tNot(tFlt), tMix),
tFunc(tOr(tInt,tFlt) tOr(tInt,tFlt),tFlt))),
OPT_TRY_OPTIMIZE,0,generate_mod);
/* function(object:mixed)|function(int:int)|function(float:float)|function(string:string) */
ADD_EFUN2("`~",f_compl,
tOr6(tFunc(tObj,tMix), tFunc(tInt,tInt),
tFunc(tFlt,tFlt),
tFunc(tStr,tStr),
tFunc(tType(tSetvar(0, tMix)), tType(tNot(tVar(0)))),
tFunc(tPrg(tObj), tType(tMix))),
OPT_TRY_OPTIMIZE,0,generate_compl);
/* function(string|multiset|array|mapping|object:int) */
ADD_EFUN2("sizeof", f_sizeof,
tFunc(tOr5(tStr,tMultiset,tArray,tMapping,tObj),tInt),
OPT_TRY_OPTIMIZE, optimize_sizeof, generate_sizeof);
/* function(mixed,mixed ...:mixed) */
ADD_EFUN2("`()",f_call_function,tFuncV(tMix,tMix,tMix),OPT_SIDE_EFFECT | OPT_EXTERNAL_DEPEND,0,generate_call_function);
/* This one should be removed */
/* function(mixed,mixed ...:mixed) */
ADD_EFUN2("call_function",f_call_function,tFuncV(tMix,tMix,tMix),OPT_SIDE_EFFECT | OPT_EXTERNAL_DEPEND,0,generate_call_function);
start_new_program();
ADD_STORAGE(struct string_assignment_storage);
/* function(int:int) */
ADD_FUNCTION2("`[]", f_string_assignment_index, tFunc(tInt,tInt), 0,
OPT_EXTERNAL_DEPEND);
/* function(int,int:int) */
ADD_FUNCTION2("`[]=", f_string_assignment_assign_index,
tFunc(tInt tInt,tInt), 0, OPT_SIDE_EFFECT);
set_init_callback(init_string_assignment_storage);
set_exit_callback(exit_string_assignment_storage);
string_assignment_program=end_program();
}
void exit_operators(void)
{
if(string_assignment_program)
{
free_program(string_assignment_program);
string_assignment_program=0;
}
}
void o_breakpoint(void)
{
/* Does nothing */
}