e576bb2002-10-11Martin Nilsson /* || 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. */
aedfb12002-10-09Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "global.h"
b788cd1998-07-04Henrik Grubbström (Grubba) #include <math.h>
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "interpret.h" #include "svalue.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "multiset.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "mapping.h" #include "array.h" #include "stralloc.h"
afc93f2010-05-28Martin Stjernholm #include "pike_float.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "opcodes.h" #include "operators.h"
9aa6fa1997-05-19Fredrik Hübinette (Hubbe) #include "pike_memory.h"
b2d3e42000-12-01Fredrik Hübinette (Hubbe) #include "pike_error.h"
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) #include "docode.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "constants.h"
8a630c1996-04-13Fredrik Hübinette (Hubbe) #include "peep.h" #include "lex.h"
07c0731996-06-21Fredrik Hübinette (Hubbe) #include "program.h" #include "object.h"
9c6f7d1997-04-15Fredrik Hübinette (Hubbe) #include "pike_types.h"
19aaeb1998-05-25Fredrik Hübinette (Hubbe) #include "module_support.h"
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) #include "pike_macros.h"
fda0de1999-10-08Fredrik Noring #include "bignum.h"
89c4452000-04-12Henrik Grubbström (Grubba) #include "builtin_functions.h"
6898c02003-11-14Martin Stjernholm #include "cyclic.h"
37775c2004-04-06Martin Nilsson #include "pike_security.h"
e021fe2008-04-14Henrik Grubbström (Grubba) #include "pike_compiler.h"
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) 
6ad2372002-05-11Martin Nilsson #define sp Pike_sp
54db6c1999-03-27Henrik Grubbström (Grubba) #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")
961aa42008-07-08Henrik Grubbström (Grubba) /* The destructive multiset merge code is broken. * l->msd gets -1 refs. * * Disable it for now. * /grubba 2008-07-08 */ #undef PIKE_MERGE_DESTR_A #define PIKE_MERGE_DESTR_A 0
afc93f2010-05-28Martin Stjernholm  /* This calculation should always give some margin based on the size. */ /* It utilizes that log10(256) ~= 2.4 < 5/2. */ /* One extra char for the sign and one for the \0 terminator. */ #define MAX_INT_SPRINTF_LEN (2 + (SIZEOF_INT_TYPE * 5 + 1) / 2)
d6b2382009-07-12Henrik Grubbström (Grubba) 
afc93f2010-05-28Martin Stjernholm  /* Enough to hold a Pike float or int in textform
3aff752008-08-26Stephen R. van den Berg  */
afc93f2010-05-28Martin Stjernholm #define MAX_NUM_BUF (MAXIMUM(MAX_INT_SPRINTF_LEN,MAX_FLOAT_SPRINTF_LEN))
3aff752008-08-26Stephen R. van den Berg 
6898c02003-11-14Martin Stjernholm void index_no_free(struct svalue *to,struct svalue *what,struct svalue *ind) { #ifdef PIKE_SECURITY
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*what) <= MAX_COMPLEX)
6898c02003-11-14Martin Stjernholm  if(!CHECK_DATA_SECURITY(what->u.array, SECURITY_BIT_INDEX)) Pike_error("Index permission denied.\n"); #endif
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*what))
6898c02003-11-14Martin Stjernholm  { 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:
017b572011-10-28Henrik Grubbström (Grubba)  object_index_no_free(to, what->u.object, SUBTYPEOF(*what), ind);
6898c02003-11-14Martin Stjernholm  break; case T_MULTISET: { int i=multiset_member(what->u.multiset, ind);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(*to, T_INT, i ? NUMBER_NUMBER : NUMBER_UNDEFINED, integer, i);
6898c02003-11-14Martin Stjernholm  break; } case T_STRING:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*ind) == T_INT)
6898c02003-11-14Martin Stjernholm  { 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);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(*to, T_INT, NUMBER_NUMBER, integer, i);
6898c02003-11-14Martin Stjernholm  break; }else{
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_STRING)
9606eb2004-11-12Henrik Grubbström (Grubba)  Pike_error ("Expected integer as string index, got \"%S\".\n", ind->u.string);
6898c02003-11-14Martin Stjernholm  else Pike_error ("Expected integer as string index, got %s.\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type (TYPEOF(*ind)));
6898c02003-11-14Martin Stjernholm  } case T_FUNCTION:
354bbe2007-09-24Henrik Grubbström (Grubba)  case T_PROGRAM: if (program_index_no_free(to, what, ind)) break; goto index_error;
6898c02003-11-14Martin Stjernholm  case T_INT:
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_STRING && !IS_UNDEFINED (what)) {
6898c02003-11-14Martin Stjernholm  INT_TYPE val = what->u.integer; convert_svalue_to_bignum(what); index_no_free(to, what, ind); if(IS_UNDEFINED(to)) { if (val) {
9606eb2004-11-12Henrik Grubbström (Grubba)  Pike_error("Indexing the integer %"PRINTPIKEINT"d " "with unknown method \"%S\".\n", val, ind->u.string);
6898c02003-11-14Martin Stjernholm  } else {
9606eb2004-11-12Henrik Grubbström (Grubba)  Pike_error("Indexing the NULL value with \"%S\".\n", ind->u.string);
6898c02003-11-14Martin Stjernholm  } } break; } /* FALL_THROUGH */ default:
354bbe2007-09-24Henrik Grubbström (Grubba)  index_error:
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_INT)
6898c02003-11-14Martin Stjernholm  Pike_error ("Cannot index %s with %"PRINTPIKEINT"d.\n",
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(*what) == T_INT && !what->u.integer)? "the NULL value":get_name_of_type(TYPEOF(*what)),
6898c02003-11-14Martin Stjernholm  ind->u.integer);
017b572011-10-28Henrik Grubbström (Grubba)  else if (TYPEOF(*ind) == T_FLOAT)
4844192009-06-30Martin Stjernholm  Pike_error ("Cannot index %s with %"PRINTPIKEFLOAT"e.\n",
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(*what) == T_INT && !what->u.integer)? "the NULL value":get_name_of_type(TYPEOF(*what)),
6898c02003-11-14Martin Stjernholm  ind->u.float_number);
017b572011-10-28Henrik Grubbström (Grubba)  else if (TYPEOF(*ind) == T_STRING)
9606eb2004-11-12Henrik Grubbström (Grubba)  Pike_error ("Cannot index %s with \"%S\".\n",
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(*what) == T_INT && !what->u.integer)? "the NULL value":get_name_of_type(TYPEOF(*what)),
9606eb2004-11-12Henrik Grubbström (Grubba)  ind->u.string);
6898c02003-11-14Martin Stjernholm  else Pike_error ("Cannot index %s with %s.\n",
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(*what) == T_INT && !what->u.integer)? "the NULL value":get_name_of_type(TYPEOF(*what)), get_name_of_type (TYPEOF(*ind)));
6898c02003-11-14Martin Stjernholm  } }
9d71082012-09-11Stefan Wallström PMOD_EXPORT void o_index(void)
6898c02003-11-14Martin Stjernholm { 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. */
e7a29a2007-12-28Henrik Grubbström (Grubba) PMOD_EXPORT void o_cast_to_int(void)
6898c02003-11-14Martin Stjernholm {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { case T_OBJECT:
ef8a142004-09-20Martin Stjernholm  if(!sp[-1].u.object->prog) { /* Casting a destructed object should be like casting a zero. */ pop_stack(); push_int (0);
6898c02003-11-14Martin Stjernholm  }
ef8a142004-09-20Martin Stjernholm  else {
6898c02003-11-14Martin Stjernholm  {
ef8a142004-09-20Martin Stjernholm  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  struct program *p = o->prog->inherits[SUBTYPEOF(sp[-1])].prog;
9793b72004-12-18Henrik Grubbström (Grubba)  int f = FIND_LFUN(p, LFUN_CAST);
ef8a142004-09-20Martin Stjernholm  if(f == -1) Pike_error("No cast method in object.\n");
6421312014-08-18Martin Nilsson  ref_push_string(literal_int_string);
ef8a142004-09-20Martin Stjernholm  apply_low(o, f, 1); stack_pop_keep_top(); }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != PIKE_T_INT)
ef8a142004-09-20Martin Stjernholm  {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_OBJECT && sp[-1].u.object->prog)
6898c02003-11-14Martin Stjernholm  {
9793b72004-12-18Henrik Grubbström (Grubba)  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN__IS_TYPE);
ef8a142004-09-20Martin Stjernholm  if( f != -1) {
6421312014-08-18Martin Nilsson  ref_push_string(literal_int_string);
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, f, 1);
ef8a142004-09-20Martin Stjernholm  f=!UNSAFE_IS_ZERO(sp-1); pop_stack(); if(f) return; }
6898c02003-11-14Martin Stjernholm  }
ef8a142004-09-20Martin Stjernholm  Pike_error("Cast failed, wanted int, got %s\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  }
2ac7142014-08-16Martin Nilsson  else if(SUBTYPEOF(sp[-1]) == NUMBER_UNDEFINED) Pike_error("Cannot cast this object to int.\n");
6898c02003-11-14Martin Stjernholm  }
ef8a142004-09-20Martin Stjernholm 
6898c02003-11-14Martin Stjernholm  break; case T_FLOAT:
b191982006-04-24Henrik Grubbström (Grubba)  if ( #ifdef HAVE_ISINF isinf(sp[-1].u.float_number) || #endif #ifdef HAVE_ISNAN isnan(sp[-1].u.float_number) || #endif 0) {
5cbe122006-04-24Henrik Grubbström (Grubba)  Pike_error("Can't cast infinites or NaN to int.\n");
b191982006-04-24Henrik Grubbström (Grubba)  } else {
6898c02003-11-14Martin Stjernholm  int i=DO_NOT_WARN((int)(sp[-1].u.float_number)); 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 {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, i);
6898c02003-11-14Martin Stjernholm  } } break; case T_STRING: /* The generic function is rather slow, so I added this * code for benchmark purposes. :-) /per */
2f260d2009-11-05Henrik Grubbström (Grubba)  if( (sp[-1].u.string->len >= 10) || sp[-1].u.string->size_shift )
6898c02003-11-14Martin Stjernholm  convert_stack_top_string_to_inumber(10);
2f260d2009-11-05Henrik Grubbström (Grubba)  else
6898c02003-11-14Martin Stjernholm  {
2f260d2009-11-05Henrik Grubbström (Grubba)  INT_TYPE i = STRTOL(sp[-1].u.string->str, 0, 10);
6898c02003-11-14Martin Stjernholm  free_string(sp[-1].u.string);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, i);
6898c02003-11-14Martin Stjernholm  } break; case PIKE_T_INT: break; default:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to int.\n", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } } /* Special case for casting to string. */
e68c782006-07-05Martin Stjernholm PMOD_EXPORT void o_cast_to_string(void)
6898c02003-11-14Martin Stjernholm {
1d37212010-02-23Stephen R. van den Berg  struct pike_string *s;
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { case T_OBJECT:
ef8a142004-09-20Martin Stjernholm  if(!sp[-1].u.object->prog) { /* Casting a destructed object should be like casting a zero. */ pop_stack();
af40e42004-09-20Henrik Grubbström (Grubba)  push_constant_text("0"); } else {
6898c02003-11-14Martin Stjernholm  {
ef8a142004-09-20Martin Stjernholm  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog, LFUN_CAST);
ef8a142004-09-20Martin Stjernholm  if(f == -1) Pike_error("No cast method in object.\n");
6421312014-08-18Martin Nilsson  ref_push_string(literal_string_string);
ef8a142004-09-20Martin Stjernholm  apply_low(o, f, 1); stack_pop_keep_top(); }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != PIKE_T_STRING)
ef8a142004-09-20Martin Stjernholm  {
2ac7142014-08-16Martin Nilsson  if(TYPEOF(sp[-1])==PIKE_T_INT && SUBTYPEOF(sp[-1])==NUMBER_UNDEFINED) Pike_error("Cannot cast this object to string.\n");
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_OBJECT && sp[-1].u.object->prog)
6898c02003-11-14Martin Stjernholm  {
9793b72004-12-18Henrik Grubbström (Grubba)  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN__IS_TYPE);
ef8a142004-09-20Martin Stjernholm  if( f != -1) {
6421312014-08-18Martin Nilsson  ref_push_string(literal_string_string);
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, f, 1);
ef8a142004-09-20Martin Stjernholm  f=!UNSAFE_IS_ZERO(sp-1); pop_stack(); if(f) return; }
6898c02003-11-14Martin Stjernholm  }
ef8a142004-09-20Martin Stjernholm  Pike_error("Cast failed, wanted string, got %s\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } }
08261e2008-08-24Stephen R. van den Berg  return;
ef8a142004-09-20Martin Stjernholm 
6898c02003-11-14Martin Stjernholm  case T_ARRAY: {
10c6632009-02-06Stephen R. van den Berg  int i, alen;
6898c02003-11-14Martin Stjernholm  struct array *a = sp[-1].u.array; int shift = 0;
10c6632009-02-06Stephen R. van den Berg  alen = a->size;
6898c02003-11-14Martin Stjernholm 
10c6632009-02-06Stephen R. van den Berg  for(i = 0; i<alen; i++) {
e956bb2008-07-11Martin Stjernholm  INT_TYPE val;
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(a->item[i]) != T_INT) {
10c6632009-02-06Stephen R. van den Berg  Pike_error( "Can only cast array(int) to string, item %d is not an integer: %O\n", i, a->item + i);
6898c02003-11-14Martin Stjernholm  }
e956bb2008-07-11Martin Stjernholm  val = a->item[i].u.integer; switch (shift) { /* Trust the compiler to strength reduce this. */ case 0: if ((unsigned INT32) val <= 0xff) break; shift = 1; /* FALL THROUGH */ case 1: if ((unsigned INT32) val <= 0xffff) break;
6898c02003-11-14Martin Stjernholm  shift = 2;
e956bb2008-07-11Martin Stjernholm  /* FALL THROUGH */ case 2: #if SIZEOF_INT_TYPE > 4 if (val < MIN_INT32 || val > MAX_INT32)
ef9b2b2014-08-18Martin Nilsson  Pike_error ("Item %d is too large: %"PRINTPIKEINT"x.\n",
e956bb2008-07-11Martin Stjernholm  i, val); #endif
6898c02003-11-14Martin Stjernholm  break; } }
e956bb2008-07-11Martin Stjernholm 
6898c02003-11-14Martin Stjernholm  s = begin_wide_shared_string(a->size, shift); switch(shift) { case 0: for(i = a->size; i--; ) {
e956bb2008-07-11Martin Stjernholm  s->str[i] = (p_wchar0) a->item[i].u.integer;
6898c02003-11-14Martin Stjernholm  } break; case 1: { p_wchar1 *str1 = STR1(s); for(i = a->size; i--; ) {
e956bb2008-07-11Martin Stjernholm  str1[i] = (p_wchar1) a->item[i].u.integer;
6898c02003-11-14Martin Stjernholm  } } break; case 2: { p_wchar2 *str2 = STR2(s); for(i = a->size; i--; ) {
e956bb2008-07-11Martin Stjernholm  str2[i] = (p_wchar2) a->item[i].u.integer;
6898c02003-11-14Martin Stjernholm  } } break; } pop_stack();
1d37212010-02-23Stephen R. van den Berg  push_string(end_shared_string(s));
6898c02003-11-14Martin Stjernholm  }
08261e2008-08-24Stephen R. van den Berg  return;
ef8a142004-09-20Martin Stjernholm 
3aff752008-08-26Stephen R. van den Berg  default:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to string.\n", get_name_of_type(TYPEOF(sp[-1])));
3aff752008-08-26Stephen R. van den Berg  case PIKE_T_STRING: return;
08261e2008-08-24Stephen R. van den Berg  case T_FLOAT:
1d37212010-02-23Stephen R. van den Berg  { char buf[MAX_FLOAT_SPRINTF_LEN+1]; format_pike_float (buf, sp[-1].u.float_number); s = make_shared_string(buf); break; }
6898c02003-11-14Martin Stjernholm 
3aff752008-08-26Stephen R. van den Berg  case T_INT:
1d37212010-02-23Stephen R. van den Berg  { INT_TYPE org; char buf[MAX_INT_SPRINTF_LEN]; register char*b = buf+sizeof buf-1; register unsigned INT_TYPE i; org = sp[-1].u.integer; *b-- = '\0'; i = org; if( org < 0 ) i = -i; goto jin; /* C as a macro assembler :-) */ do { i /= 10; jin: *b-- = '0'+(i%10); } while( i >= 10 ); if( org < 0 ) *b = '-'; else b++; s = make_shared_string(b); }
3aff752008-08-26Stephen R. van den Berg  break;
6898c02003-11-14Martin Stjernholm  }
1d37212010-02-23Stephen R. van den Berg  SET_SVAL(sp[-1], PIKE_T_STRING, 0, string, s);
6898c02003-11-14Martin Stjernholm }
e7a29a2007-12-28Henrik Grubbström (Grubba) PMOD_EXPORT void o_cast(struct pike_type *type, INT32 run_time_type)
6898c02003-11-14Martin Stjernholm {
017b572011-10-28Henrik Grubbström (Grubba)  if(run_time_type != TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { if(run_time_type == T_MIXED) return;
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) == T_OBJECT && !sp[-1].u.object->prog) {
ef8a142004-09-20Martin Stjernholm  /* Casting a destructed object should be like casting a zero. */ pop_stack(); push_int (0); }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_OBJECT)
6898c02003-11-14Martin Stjernholm  {
ef8a142004-09-20Martin Stjernholm  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog, LFUN_CAST);
547cf32012-10-27Henrik Grubbström (Grubba)  if(f == -1) { if (run_time_type != T_PROGRAM) { Pike_error("No cast method in object.\n"); } f_object_program(1); return; }
b5cdce2014-08-16Martin Nilsson  push_text(get_name_of_type(type->type));
af40e42004-09-20Henrik Grubbström (Grubba)  apply_low(o, f, 1);
547cf32012-10-27Henrik Grubbström (Grubba)  if (run_time_type == T_PROGRAM) { if (IS_UNDEFINED(Pike_sp-1)) { pop_stack(); f_object_program(1); return; } }
ef8a142004-09-20Martin Stjernholm  stack_pop_keep_top();
547cf32012-10-27Henrik Grubbström (Grubba) 
f506fa2014-08-18Martin Nilsson  if(TYPEOF(sp[-1]) == T_INT && SUBTYPEOF(sp[-1]) == NUMBER_UNDEFINED) Pike_error("Cannot cast this object to %s.\n", get_name_of_type(type->type));
547cf32012-10-27Henrik Grubbström (Grubba)  } else
6898c02003-11-14Martin Stjernholm  switch(run_time_type) { default: Pike_error("Cannot perform cast to that type.\n"); case T_MIXED: return; case T_MULTISET:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { case T_ARRAY: { extern void f_mkmultiset(INT32); f_mkmultiset(1); break; } default:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to multiset.\n", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } break; case T_MAPPING:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { 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++) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(ITEM(a)[i]) != T_ARRAY)
6898c02003-11-14Martin Stjernholm  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:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to mapping.\n", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } break; case T_ARRAY:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { 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:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to array.\n", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } 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;
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { 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:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to float.\n", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_FLOAT, 0, float_number, f);
6898c02003-11-14Martin Stjernholm  break; } case T_OBJECT:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { case T_STRING: { struct pike_string *file;
ef24a82012-01-12Henrik Grubbström (Grubba)  INT_TYPE lineno;
6898c02003-11-14Martin Stjernholm  if(Pike_fp->pc &&
fa93a52008-02-28Henrik Grubbström (Grubba)  (file = low_get_line(Pike_fp->pc, Pike_fp->context->prog, &lineno))) {
6898c02003-11-14Martin Stjernholm  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:
017b572011-10-28Henrik Grubbström (Grubba)  if (SUBTYPEOF(Pike_sp[-1]) == FUNCTION_BUILTIN) {
6898c02003-11-14Martin Stjernholm  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 {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL_TYPE(Pike_sp[-1], T_OBJECT); SET_SVAL_SUBTYPE(Pike_sp[-1], 0);
6898c02003-11-14Martin Stjernholm  } break; default:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to object.\n", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } break; case T_PROGRAM:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { case T_STRING: { struct pike_string *file;
ef24a82012-01-12Henrik Grubbström (Grubba)  INT_TYPE lineno;
6898c02003-11-14Martin Stjernholm  if(Pike_fp->pc &&
fa93a52008-02-28Henrik Grubbström (Grubba)  (file = low_get_line(Pike_fp->pc, Pike_fp->context->prog, &lineno))) {
6898c02003-11-14Martin Stjernholm  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;
349bc72014-02-26Henrik Grubbström (Grubba)  case PIKE_T_TYPE: { struct pike_type *t = Pike_sp[-1].u.type; struct program *p = program_from_type(t); pop_stack(); if (p) { ref_push_program(p); } else { push_int(0); } return; }
6898c02003-11-14Martin Stjernholm  default:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to a program.\n", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } } }
017b572011-10-28Henrik Grubbström (Grubba)  if(run_time_type != TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  {
547cf32012-10-27Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1])) { case T_OBJECT: if(sp[-1].u.object->prog)
6898c02003-11-14Martin Stjernholm  {
547cf32012-10-27Henrik Grubbström (Grubba)  struct object *o = sp[-1].u.object; int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog, LFUN__IS_TYPE); if( f != -1) { push_text(get_name_of_type(run_time_type)); apply_low(o, f, 1); f=!UNSAFE_IS_ZERO(sp-1); pop_stack(); if(f) goto emulated_type_ok; } } break; case T_FUNCTION: /* Check that the function actually is a program. */ if ((run_time_type == T_PROGRAM) && program_from_function(sp-1)) { return; /* No need for further post-processing. */
6898c02003-11-14Martin Stjernholm  }
547cf32012-10-27Henrik Grubbström (Grubba)  break;
6898c02003-11-14Martin Stjernholm  } Pike_error("Cast failed, wanted %s, got %s\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type(run_time_type), get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } 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);
017b572011-10-28Henrik Grubbström (Grubba)  types |= 1 << TYPEOF(ITEM(a)[e]);
6898c02003-11-14Martin Stjernholm  } 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; struct multiset *tmp=sp[-2].u.multiset; 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 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);
49e4ec2014-05-05Per Hedbor  multiset_insert (m, sp - 1);
6898c02003-11-14Martin Stjernholm  pop_stack(); } while ((nodepos = multiset_next (tmp, nodepos)) >= 0); UNSET_ONERROR (uwp); sub_msnode_ref (tmp); } #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;
fa666b2004-04-15Martin Nilsson  struct mapping_data *md;
6898c02003-11-14Martin Stjernholm #ifdef PIKE_DEBUG struct svalue *save_sp=sp+1; #endif push_mapping(m=allocate_mapping(m_sizeof(tmp))); SET_CYCLIC_RET(m);
fa666b2004-04-15Martin Nilsson  md = tmp->data; NEW_MAPPING_LOOP(md)
6898c02003-11-14Martin Stjernholm  { 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;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) != T_TYPE)
6898c02003-11-14Martin Stjernholm  Pike_fatal("Cast expression destroyed stack or left droppings! (Type:%d)\n",
017b572011-10-28Henrik Grubbström (Grubba)  TYPEOF(sp[-2]));
6898c02003-11-14Martin Stjernholm #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); }
b5955a2006-08-21Henrik Grubbström (Grubba) /* Returns 1 if s is a valid in the type type. */ int low_check_soft_cast(struct svalue *s, struct pike_type *type)
257fcd2006-08-15Henrik Grubbström (Grubba) { loop: switch(type->type) {
b5955a2006-08-21Henrik Grubbström (Grubba)  case T_MIXED: return 1; case T_ZERO:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*s)) {
b5955a2006-08-21Henrik Grubbström (Grubba)  case PIKE_T_INT: return !s->u.integer; case PIKE_T_FUNCTION:
017b572011-10-28Henrik Grubbström (Grubba)  if (SUBTYPEOF(*s) == FUNCTION_BUILTIN) return 0;
b5955a2006-08-21Henrik Grubbström (Grubba)  /* FALL_THROUGH */ case PIKE_T_OBJECT: return !s->u.object->prog; }
257fcd2006-08-15Henrik Grubbström (Grubba)  return 0;
b5955a2006-08-21Henrik Grubbström (Grubba)  case T_ASSIGN:
257fcd2006-08-15Henrik Grubbström (Grubba)  case PIKE_T_NAME:
5f91642013-02-19Henrik Grubbström (Grubba)  case PIKE_T_ATTRIBUTE:
b5955a2006-08-21Henrik Grubbström (Grubba)  type = type->cdr; goto loop;
257fcd2006-08-15Henrik Grubbström (Grubba)  case T_AND:
b5955a2006-08-21Henrik Grubbström (Grubba)  if (!low_check_soft_cast(s, type->car)) return 0; type = type->cdr; goto loop;
257fcd2006-08-15Henrik Grubbström (Grubba)  case T_OR:
b5955a2006-08-21Henrik Grubbström (Grubba)  if (low_check_soft_cast(s, type->car)) return 1; type = type->cdr; goto loop; case T_NOT: return !low_check_soft_cast(s, type->car); }
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(*s) == PIKE_T_INT) && !s->u.integer) return 1; if (TYPEOF(*s) == type->type) {
53d2e92013-02-19Henrik Grubbström (Grubba)  switch(type->type) { case PIKE_T_INT:
cba1092007-04-26Henrik Grubbström (Grubba)  if (((((INT32)CAR_TO_INT(type)) != MIN_INT32) && (s->u.integer < (INT32)CAR_TO_INT(type))) || ((((INT32)CDR_TO_INT(type)) != MAX_INT32) && (s->u.integer > (INT32)CDR_TO_INT(type)))) { return 0; } return 1;
53d2e92013-02-19Henrik Grubbström (Grubba)  case PIKE_T_FLOAT: return 1; case PIKE_T_STRING:
cba1092007-04-26Henrik Grubbström (Grubba)  if ((8<<s->u.string->size_shift) > CAR_TO_INT(type)) { return 0; } return 1;
b5955a2006-08-21Henrik Grubbström (Grubba)  case PIKE_T_OBJECT: { struct program *p; /* Common cases. */ if (!type->cdr) return 1; if (s->u.object->prog->id == CDR_TO_INT(type)) return 1; p = id_to_program(CDR_TO_INT(type)); if (!p) return 1; return implements(s->u.object->prog, p); } case PIKE_T_PROGRAM: { struct program *p; /* Common cases. */ if (!type->car->cdr) return 1; if (s->u.program->id == CDR_TO_INT(type->car)) return 1; p = id_to_program(CDR_TO_INT(type->car)); if (!p) return 1; return implements(s->u.program, p); } case PIKE_T_ARRAY: { struct array *a = s->u.array; int i; for (i = a->size; i--;) { if (!low_check_soft_cast(a->item + i, type->car)) return 0; } } break; case PIKE_T_MULTISET: /* FIXME: Add code here. */ break; case PIKE_T_MAPPING: /* FIXME: Add code here. */ break; case PIKE_T_FUNCTION: /* FIXME: Add code here. */ break; case PIKE_T_TYPE: /* FIXME: Add code here. */ break; } return 1; }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*s) == PIKE_T_OBJECT) {
b5955a2006-08-21Henrik Grubbström (Grubba)  int lfun; if (!s->u.object->prog) return 0; if (type->type == PIKE_T_FUNCTION) { if ((lfun = FIND_LFUN(s->u.object->prog, LFUN_CALL)) != -1) { /* FIXME: Add code here. */ return 1; } } if ((lfun = FIND_LFUN(s->u.object->prog, LFUN__IS_TYPE)) != -1) { int ret; push_text(get_name_of_type(type->type)); apply_low(s->u.object, lfun, 1); ret = !UNSAFE_IS_ZERO(Pike_sp-1); pop_stack(); return ret; }
257fcd2006-08-15Henrik Grubbström (Grubba)  return 0; }
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(*s) == PIKE_T_FUNCTION) && (type->type == PIKE_T_PROGRAM)) {
b5955a2006-08-21Henrik Grubbström (Grubba)  /* FIXME: Add code here. */ return 1; }
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(*s) == PIKE_T_FUNCTION) && (type->type == T_MANY)) {
b5955a2006-08-21Henrik Grubbström (Grubba)  /* FIXME: Add code here. */ return 1; } return 0;
257fcd2006-08-15Henrik Grubbström (Grubba) } void o_check_soft_cast(struct svalue *s, struct pike_type *type) {
b5955a2006-08-21Henrik Grubbström (Grubba)  if (!low_check_soft_cast(s, type)) { /* Note: get_type_from_svalue() doesn't return a fully specified type
257fcd2006-08-15Henrik Grubbström (Grubba)  * for array, mapping and multiset, so we perform a more lenient * check for them. */
b5955a2006-08-21Henrik Grubbström (Grubba)  struct pike_type *sval_type = get_type_of_svalue(s); struct pike_string *t1;
c554732013-02-19Henrik Grubbström (Grubba)  struct string_builder s;
b5955a2006-08-21Henrik Grubbström (Grubba)  char *fname = "__soft-cast";
c554732013-02-19Henrik Grubbström (Grubba)  ONERROR tmp0;
b5955a2006-08-21Henrik Grubbström (Grubba)  ONERROR tmp1;
c554732013-02-19Henrik Grubbström (Grubba)  init_string_builder(&s, 0); SET_ONERROR(tmp0, free_string_builder, &s); string_builder_explain_nonmatching_types(&s, type, sval_type);
b5955a2006-08-21Henrik Grubbström (Grubba) 
fa93a52008-02-28Henrik Grubbström (Grubba)  if (Pike_fp->current_program) {
b5955a2006-08-21Henrik Grubbström (Grubba)  /* Look up the function-name */ struct pike_string *name =
fa93a52008-02-28Henrik Grubbström (Grubba)  ID_FROM_INT(Pike_fp->current_program, Pike_fp->fun)->name;
b5955a2006-08-21Henrik Grubbström (Grubba)  if ((!name->size_shift) && (name->len < 100)) fname = name->str; }
257fcd2006-08-15Henrik Grubbström (Grubba) 
b5955a2006-08-21Henrik Grubbström (Grubba)  t1 = describe_type(type); SET_ONERROR(tmp1, do_free_string, t1);
257fcd2006-08-15Henrik Grubbström (Grubba) 
b5955a2006-08-21Henrik Grubbström (Grubba)  free_type(sval_type); bad_arg_error(NULL, Pike_sp-1, 1, 1, t1->str, Pike_sp-1,
c554732013-02-19Henrik Grubbström (Grubba)  "%s(): Soft cast failed.\n%S", fname, s.s);
b5955a2006-08-21Henrik Grubbström (Grubba)  /* NOT_REACHED */
c554732013-02-19Henrik Grubbström (Grubba)  CALL_AND_UNSET_ONERROR(tmp1); CALL_AND_UNSET_ONERROR(tmp0);
257fcd2006-08-15Henrik Grubbström (Grubba)  } }
5b4dd31998-02-23Fredrik Hübinette (Hubbe) #define COMPARISON(ID,NAME,FUN) \
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void ID(INT32 args) \
5b4dd31998-02-23Fredrik Hübinette (Hubbe) { \ int i; \ switch(args) \ { \ case 0: case 1: \
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR(NAME, 2); \
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  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); \ } \
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @decl int(0..1) `!=(mixed arg1, mixed arg2, mixed ... extras) *!
dfceb02003-11-10Martin Stjernholm  *! Inequality test.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! @returns *! Returns @expr{1@} if the test is successful, @expr{0@} *! otherwise.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @seealso *! @[`==()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_ne(INT32 args)
5b4dd31998-02-23Fredrik Hübinette (Hubbe) { f_eq(args); o_not(); }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @decl int(0..1) `==(mixed arg1, mixed arg2, mixed ... extras) *!
dfceb02003-11-10Martin Stjernholm  *! 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
75dc292005-01-14Martin Nilsson  *! function is called with the second as argument, unless the *! second argument is the same as the first argument. The test is
dfceb02003-11-10Martin Stjernholm  *! 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
697ffd2014-05-23Chris Angelico  *! Successful iff the two floats are numerically equal and *! not NaN.
dfceb02003-11-10Martin Stjernholm  *! @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
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
dfceb02003-11-10Martin Stjernholm  *! 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.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @seealso
dfceb02003-11-10Martin Stjernholm  *! @[`!()], @[`!=()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
5b4dd31998-02-23Fredrik Hübinette (Hubbe) COMPARISON(f_eq,"`==", is_eq)
f09ec92001-02-07Henrik Grubbström (Grubba)  /*! @decl int(0..1) `<(mixed arg1, mixed arg2, mixed ... extras) *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
dfceb02003-11-10Martin Stjernholm  *! Returns @expr{1@} if the test is successful, @expr{0@} *! otherwise.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @seealso *! @[`<=()], @[`>()], @[`>=()] */
5b4dd31998-02-23Fredrik Hübinette (Hubbe) COMPARISON(f_lt,"`<" , is_lt)
f09ec92001-02-07Henrik Grubbström (Grubba)  /*! @decl int(0..1) `<=(mixed arg1, mixed arg2, mixed ... extras) *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
f5971b2004-11-27Martin Stjernholm  *! Returns @expr{1@} if the test is successful, @expr{0@} *! otherwise.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
f5971b2004-11-27Martin Stjernholm  *! @note *! For total orders, e.g. integers, this is the inverse of @[`>()].
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @seealso *! @[`<()], @[`>()], @[`>=()] */
f5971b2004-11-27Martin Stjernholm COMPARISON(f_le,"`<=",is_le)
f09ec92001-02-07Henrik Grubbström (Grubba)  /*! @decl int(0..1) `>(mixed arg1, mixed arg2, mixed ... extras) *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if the arguments are strictly decreasing, and *! @expr{0@} (zero) otherwise.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @seealso *! @[`<()], @[`<=()], @[`>=()] */
5b4dd31998-02-23Fredrik Hübinette (Hubbe) COMPARISON(f_gt,"`>" , is_gt)
f09ec92001-02-07Henrik Grubbström (Grubba)  /*! @decl int(0..1) `>=(mixed arg1, mixed arg2, mixed ... extras) *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
f5971b2004-11-27Martin Stjernholm  *! Returns @expr{1@} if the test is successful, @expr{0@} *! otherwise.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
f5971b2004-11-27Martin Stjernholm  *! @note *! For total orders, e.g. integers, this is the inverse of @[`<()].
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @seealso *! @[`<=()], @[`>()], @[`<()] */
f5971b2004-11-27Martin Stjernholm COMPARISON(f_ge,"`>=",is_ge)
5267b71995-08-09Fredrik Hübinette (Hubbe) 
33c9582003-11-10Martin Stjernholm #define CALL_OPERATOR(OP, args) do { \
408a1e2004-10-30Martin Stjernholm  struct object *o_ = sp[-args].u.object; \
33c9582003-11-10Martin Stjernholm  int i; \
408a1e2004-10-30Martin Stjernholm  if(!o_->prog) \
33c9582003-11-10Martin Stjernholm  bad_arg_error(lfun_names[OP], sp-args, args, 1, "object", sp-args, \ "Called in destructed object.\n"); \
017b572011-10-28Henrik Grubbström (Grubba)  if((i = FIND_LFUN(o_->prog->inherits[SUBTYPEOF(sp[-args])].prog, \
9793b72004-12-18Henrik Grubbström (Grubba)  OP)) == -1) \
33c9582003-11-10Martin Stjernholm  bad_arg_error(lfun_names[OP], sp-args, args, 1, "object", sp-args, \ "Operator not in object.\n"); \
408a1e2004-10-30Martin Stjernholm  apply_low(o_, i, args-1); \ stack_pop_keep_top(); \
33c9582003-11-10Martin Stjernholm  } while (0)
5267b71995-08-09Fredrik Hübinette (Hubbe) 
56a2612005-09-15Henrik Grubbström (Grubba) /* Helper function for calling ``-operators. * * Assumes o is at Pike_sp[e - args]. * * i is the resolved lfun to call. * * Returns the number of remaining elements on the stack. */ PMOD_EXPORT INT32 low_rop(struct object *o, int i, INT32 e, INT32 args) { if (e == args-1) { /* The object is the last argument. */ ONERROR err; Pike_sp--; SET_ONERROR(err, do_free_object, o); apply_low(o, i, e); CALL_AND_UNSET_ONERROR(err); return args - e; } else { /* Rotate the stack, so that the @[e] first elements come last. */ struct svalue *tmp; if (e*2 < args) { tmp = xalloc(e*sizeof(struct svalue)); memcpy(tmp, Pike_sp-args, e*sizeof(struct svalue)); memmove(Pike_sp-args, (Pike_sp-args)+e, (args-e)*sizeof(struct svalue)); memcpy(Pike_sp-e, tmp, e*sizeof(struct svalue)); } else { tmp = xalloc((args-e)*sizeof(struct svalue)); memcpy(tmp, (Pike_sp-args)+e, (args-e)*sizeof(struct svalue)); memmove(Pike_sp-e, Pike_sp-args, e*sizeof(struct svalue)); memcpy(Pike_sp-args, tmp, (args-e)*sizeof(struct svalue)); } free(tmp); /* Now the stack is: * * -args object with the lfun. * ... * ... other arguments * ... * -e first argument. * ... * -1 last argument before the object. */ #ifdef PIKE_DEBUG
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(Pike_sp[-args]) != T_OBJECT ||
56a2612005-09-15Henrik Grubbström (Grubba)  Pike_sp[-args].u.object != o || !o->prog) { Pike_fatal("low_rop() Lost track of object.\n"); } #endif /* PIKE_DEBUG */ apply_low(o, i, e); args -= e; /* Replace the object with the result. */ assign_svalue(Pike_sp-(args+1), Pike_sp-1); pop_stack(); return args; } }
08b3ec2011-04-08Henrik Grubbström (Grubba) /* Sift down large (absolute) values on the heap. */ static void float_heap_sift_down(struct svalue *svalues, int root, int nelems) { FLOAT_ARG_TYPE val = svalues[root].u.float_number;
a337842011-04-09Henrik Grubbström (Grubba)  FLOAT_ARG_TYPE abs_val = fabs(val);
08b3ec2011-04-08Henrik Grubbström (Grubba)  int child; while ((child = ((root<<1) +1)) < nelems) { int swap = root; FLOAT_ARG_TYPE s_abs_val;
a337842011-04-09Henrik Grubbström (Grubba)  if ((s_abs_val = fabs(svalues[child].u.float_number)) < abs_val) {
08b3ec2011-04-08Henrik Grubbström (Grubba)  swap = child; } else { s_abs_val = abs_val; } child++; if ((child < nelems) &&
a337842011-04-09Henrik Grubbström (Grubba)  (fabs(svalues[child].u.float_number) < s_abs_val)) {
08b3ec2011-04-08Henrik Grubbström (Grubba)  swap = child; } if (swap == root) break; svalues[root] = svalues[swap]; root = swap; } svalues[root].u.float_number = val; }
09cae22003-11-12Martin Stjernholm /*! @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)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns
dfceb02003-11-10Martin Stjernholm  *! If there's a single argument, that argument is returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
09cae22003-11-12Martin Stjernholm  *! If @[arg] is an object with only one reference and an
dfceb02003-11-10Martin Stjernholm  *! @[lfun::`+=()], that function is called with the rest of the *! arguments, and its result is returned.
5d91362003-04-18Martin Stjernholm  *!
09cae22003-11-12Martin Stjernholm  *! Otherwise, if @[arg] is an object with an @[lfun::`+()], that
dfceb02003-11-10Martin Stjernholm  *! function is called with the rest of the arguments, and its
5d91362003-04-18Martin Stjernholm  *! result is returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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
5d91362003-04-18Martin Stjernholm  *! recursively with the result and the rest of the arguments.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
09cae22003-11-12Martin Stjernholm  *! 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.
dfceb02003-11-10Martin Stjernholm  *! *! Otherwise the result depends on the argument types:
09cae22003-11-12Martin Stjernholm  *! @mixed
dfceb02003-11-10Martin Stjernholm  *! @type int|float
09cae22003-11-12Martin Stjernholm  *! 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.
dfceb02003-11-10Martin Stjernholm  *! @type array
09cae22003-11-12Martin Stjernholm  *! The array arguments are concatened in order to form the *! result.
dfceb02003-11-10Martin Stjernholm  *! @type mapping
09cae22003-11-12Martin Stjernholm  *! 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.
dfceb02003-11-10Martin Stjernholm  *! @type multiset
09cae22003-11-12Martin Stjernholm  *! 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.
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @note *! In Pike 7.0 and earlier the addition order was unspecified. *!
09cae22003-11-12Martin Stjernholm  *! The treatment of @[UNDEFINED] was new
f09ec92001-02-07Henrik Grubbström (Grubba)  *! in Pike 7.0. *! *! @seealso *! @[`-()], @[lfun::`+()], @[lfun::``+()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_add(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
70b4311998-02-27Fredrik Hübinette (Hubbe)  INT_TYPE e,size;
5267b71995-08-09Fredrik Hübinette (Hubbe)  TYPE_FIELD types;
430fce2004-08-11Henrik Grubbström (Grubba)  tail_recurse:
08b3ec2011-04-08Henrik Grubbström (Grubba)  if (args == 1) return;
5267b71995-08-09Fredrik Hübinette (Hubbe)  types=0;
017b572011-10-28Henrik Grubbström (Grubba)  for(e=-args;e<0;e++) types |= 1<<TYPEOF(sp[e]);
5267b71995-08-09Fredrik Hübinette (Hubbe)  switch(types) { default:
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(!args)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("`+", 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }else{ if(types & BIT_OBJECT)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
9793b72004-12-18Henrik Grubbström (Grubba)  struct object *o; struct program *p; int i;
33c9582003-11-10Martin Stjernholm  if (args == 1) return;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) == T_OBJECT && sp[-args].u.object->prog)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
430fce2004-08-11Henrik Grubbström (Grubba)  /* The first argument is an object. */
9793b72004-12-18Henrik Grubbström (Grubba)  o = sp[-args].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  p = o->prog->inherits[SUBTYPEOF(sp[-args])].prog;
9793b72004-12-18Henrik Grubbström (Grubba)  if(o->refs==1 && (i = FIND_LFUN(p, LFUN_ADD_EQ)) != -1)
ee37801999-02-09Fredrik Hübinette (Hubbe)  {
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, args-1);
0d0bab2003-04-27Martin Stjernholm  stack_pop_keep_top();
ee37801999-02-09Fredrik Hübinette (Hubbe)  return; }
9793b72004-12-18Henrik Grubbström (Grubba)  if((i = FIND_LFUN(p, LFUN_ADD)) != -1)
ee37801999-02-09Fredrik Hübinette (Hubbe)  {
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, args-1);
ee37801999-02-09Fredrik Hübinette (Hubbe)  free_svalue(sp-2); sp[-2]=sp[-1]; sp--;
41e2cb1999-10-24Henrik Grubbström (Grubba)  dmalloc_touch_svalue(sp);
ee37801999-02-09Fredrik Hübinette (Hubbe)  return; }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
33c9582003-11-10Martin Stjernholm 
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  for(e=1;e<args;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) == T_OBJECT &&
9793b72004-12-18Henrik Grubbström (Grubba)  (p = (o = sp[e-args].u.object)->prog) &&
017b572011-10-28Henrik Grubbström (Grubba)  (i = FIND_LFUN(p->inherits[SUBTYPEOF(sp[e-args])].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN_RADD)) != -1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
430fce2004-08-11Henrik Grubbström (Grubba)  /* There's an object with a lfun::``+() at argument @[e]. */
e9cac62005-09-15Henrik Grubbström (Grubba)  if ((args = low_rop(o, i, e, args)) > 1) {
430fce2004-08-11Henrik Grubbström (Grubba)  goto tail_recurse;
e9cac62005-09-15Henrik Grubbström (Grubba)  } return;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  } } } }
07c0731996-06-21Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-args]))
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_PROGRAM: case T_FUNCTION:
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`+", 1, "string|object|int|float|array|mapping|multiset");
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
54db6c1999-03-27Henrik Grubbström (Grubba)  bad_arg_error("`+", sp-args, args, 1, "string|object|int|float|array|mapping|multiset", sp-args, "Incompatible types\n");
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; /* compiler hint */ case BIT_STRING: {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *r;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  PCHARP buf;
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t tmp;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  int max_shift=0; if(args==1) return; size=0; for(e=-args;e<0;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
3e625c1998-10-11Fredrik Hübinette (Hubbe)  size+=sp[e].u.string->len; if(sp[e].u.string->size_shift > max_shift) max_shift=sp[e].u.string->size_shift;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
66769e1999-11-04Fredrik Hübinette (Hubbe)  if(size == sp[-args].u.string->len) { pop_n_elems(args-1); return; }
2fd4732013-05-20Per Hedbor  else if(args == 2 && (size == sp[-1].u.string->len)) { stack_swap(); pop_stack(); return; }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  tmp=sp[-args].u.string->len; r=new_realloc_shared_string(sp[-args].u.string,size,max_shift);
1ab4ac2008-01-26Martin Stjernholm  mark_free_svalue (sp - args);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  buf=MKPCHARP_STR_OFF(r,tmp);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(e=-args+1;e<0;e++) {
d3a1382013-05-31Per Hedbor  if( sp[e].u.string->len ) { update_flags_for_add( r, sp[e].u.string ); pike_string_cpy(buf,sp[e].u.string); INC_PCHARP(buf,sp[e].u.string->len); }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-args], T_STRING, 0, string, low_end_shared_string(r));
d3a1382013-05-31Per Hedbor  for(e=-args+1;e<0;e++) free_string(sp[e].u.string);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  sp-=args-1;
8a630c1996-04-13Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; } case BIT_STRING | BIT_INT: case BIT_STRING | BIT_FLOAT: case BIT_STRING | BIT_FLOAT | BIT_INT: {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *r;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  PCHARP buf;
3aff752008-08-26Stephen R. van den Berg  char buffer[MAX_NUM_BUF];
462b982014-02-24Per Hedbor  int max_shift=0, len;
d67c6d2000-09-22Henrik Grubbström (Grubba) 
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(sp[-args]) != T_STRING) && (TYPEOF(sp[1-args]) != T_STRING)) {
d67c6d2000-09-22Henrik Grubbström (Grubba)  struct svalue *save_sp = sp; /* We need to perform a normal addition first. */ for (e=-args; e < 0; e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(save_sp[e]) == T_STRING)
d67c6d2000-09-22Henrik Grubbström (Grubba)  break; *(sp++) = save_sp[e];
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
d67c6d2000-09-22Henrik Grubbström (Grubba)  } /* Perform the addition. */ f_add(args+e);
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
d67c6d2000-09-22Henrik Grubbström (Grubba)  save_sp[--e] = *(--sp); #ifdef PIKE_DEBUG if (sp != save_sp) {
5aad932002-08-15Marcus Comstedt  Pike_fatal("f_add(): Lost track of stack %p != %p\n", sp, save_sp);
d67c6d2000-09-22Henrik Grubbström (Grubba)  } #endif /* PIKE_DEBUG */ /* Perform the rest of the addition. */ f_add(-e); #ifdef PIKE_DEBUG if (sp != save_sp + 1 + e) {
5aad932002-08-15Marcus Comstedt  Pike_fatal("f_add(): Lost track of stack (2) %p != %p\n",
d67c6d2000-09-22Henrik Grubbström (Grubba)  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; }
561e752008-05-21Martin Stjernholm 
5267b71995-08-09Fredrik Hübinette (Hubbe)  size=0; for(e=-args;e<0;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[e]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_STRING: size+=sp[e].u.string->len;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  if(sp[e].u.string->size_shift > max_shift) max_shift=sp[e].u.string->size_shift;
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_INT:
561e752008-05-21Martin Stjernholm  size += MAX_INT_SPRINTF_LEN;
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_FLOAT:
561e752008-05-21Martin Stjernholm  size += MAX_FLOAT_SPRINTF_LEN;
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; } }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  r=begin_wide_shared_string(size,max_shift);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  buf=MKPCHARP_STR(r);
5267b71995-08-09Fredrik Hübinette (Hubbe)  size=0; for(e=-args;e<0;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[e]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_STRING:
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  pike_string_cpy(buf,sp[e].u.string); INC_PCHARP(buf,sp[e].u.string->len);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_INT:
01f9cc2003-11-13Martin Stjernholm  sprintf(buffer,"%"PRINTPIKEINT"d",sp[e].u.integer);
561e752008-05-21Martin Stjernholm #ifdef PIKE_DEBUG if (strlen (buffer) > MAX_INT_SPRINTF_LEN) Pike_fatal ("Formatted integer %s is %"PRINTSIZET"u, " "longer than assumed max %"PRINTSIZET"u.\n", buffer, strlen (buffer), MAX_INT_SPRINTF_LEN); #endif
3e625c1998-10-11Fredrik Hübinette (Hubbe)  goto append_buffer;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT:
3aff752008-08-26Stephen R. van den Berg  sprintf(buffer,"%.*"PRINTPIKEFLOAT"g",
9c04092009-08-05Martin Stjernholm  PIKEFLOAT_DIG, sp[e].u.float_number);
4844192009-06-30Martin Stjernholm  /* See comment for T_FLOAT in o_cast_to_string. */
b13bc32009-06-30Martin Stjernholm  if (!strchr (buffer, '.') && !strchr (buffer, 'e'))
4844192009-06-30Martin Stjernholm  strcat (buffer, ".0");
561e752008-05-21Martin Stjernholm #ifdef PIKE_DEBUG if (strlen (buffer) > MAX_FLOAT_SPRINTF_LEN) Pike_fatal ("Formatted float %s is %"PRINTSIZET"u, " "longer than assumed max %"PRINTSIZET"u.\n", buffer, strlen (buffer), MAX_FLOAT_SPRINTF_LEN); #endif
3e625c1998-10-11Fredrik Hübinette (Hubbe)  append_buffer:
462b982014-02-24Per Hedbor  len = strlen(buffer);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  switch(max_shift) {
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  case 0:
462b982014-02-24Per Hedbor  convert_0_to_0((p_wchar0 *)buf.ptr,buffer,len);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break; case 1:
462b982014-02-24Per Hedbor  convert_0_to_1((p_wchar1 *)buf.ptr,(p_wchar0 *)buffer,len);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break; case 2:
462b982014-02-24Per Hedbor  convert_0_to_2((p_wchar2 *)buf.ptr,(p_wchar0 *)buffer,len);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  }
462b982014-02-24Per Hedbor  INC_PCHARP(buf,len);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
4949682001-09-25Henrik Grubbström (Grubba)  r = realloc_unlinked_string(r, SUBTRACT_PCHARP(buf, MKPCHARP_STR(r))); r = low_end_shared_string(r);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(r); break; } case BIT_INT:
42d0cd2012-12-31Arne Goedeke  { int of = 0;
fda0de1999-10-08Fredrik Noring  size = 0; for(e = -args; e < 0; e++) {
60586c2014-01-11Arne Goedeke  if (DO_INT_TYPE_ADD_OVERFLOW(size, sp[e].u.integer, &size)) { convert_svalue_to_bignum(sp-args); f_add(args); return; }
fda0de1999-10-08Fredrik Noring  }
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  sp-=args; push_int(size);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
42d0cd2012-12-31Arne Goedeke  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  case BIT_FLOAT:
08b3ec2011-04-08Henrik Grubbström (Grubba)  if (args > 2) { /* Attempt to minimize the accumulated summation error * by adding the smallest (absolute) values first. *
8496b22011-04-09Henrik Grubbström (Grubba)  * Large accumulated errors can occur eg when the number * of values to add is of the same order as the largest * number representable by the mantissa alone. ie when * the sum differs by an order of magnitude from a * typical term.
08b3ec2011-04-08Henrik Grubbström (Grubba)  */ /* Heapify */ for(e = args>>1; e--;) { float_heap_sift_down(Pike_sp-args, e, args); } while (args > 2) {
8496b22011-04-09Henrik Grubbström (Grubba)  /* Pop the smallest element from the heap. */
08b3ec2011-04-08Henrik Grubbström (Grubba)  FLOAT_ARG_TYPE top = Pike_sp[-args].u.float_number;
416a452012-06-22Per Hedbor  Pike_sp[-args] = Pike_sp[-1]; Pike_sp--;
08b3ec2011-04-08Henrik Grubbström (Grubba)  args--; float_heap_sift_down(Pike_sp-args, 0, args);
8496b22011-04-09Henrik Grubbström (Grubba)  /* And add it to the second smallest. */
08b3ec2011-04-08Henrik Grubbström (Grubba)  Pike_sp[-args].u.float_number += top; float_heap_sift_down(Pike_sp-args, 0, args); } } sp[-2].u.float_number += sp[-1].u.float_number; sp--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
482fb51999-03-12Per Hedbor  case BIT_FLOAT|BIT_INT:
bce86c1996-02-25Fredrik Hübinette (Hubbe)  {
08b3ec2011-04-08Henrik Grubbström (Grubba)  /* For improved precision; partition the values * into floats followed by ints, so that we * can add the integers exactly. */ int i = args-1; e = 0; while (e < i) { for(;e < i; i--) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[i-args]) == T_FLOAT) break;
08b3ec2011-04-08Henrik Grubbström (Grubba)  } for(;e < i; e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[e-args]) == T_INT) break;
08b3ec2011-04-08Henrik Grubbström (Grubba)  } if (e < i) { /* Swap */ struct svalue sval = sp[e-args]; sp[e-args] = sp[i-args]; sp[i-args] = sval;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  } }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[e-args]) == T_FLOAT) e++;
08b3ec2011-04-08Henrik Grubbström (Grubba)  /* Sum the integers. */ if (args - e > 1) { f_add(args-e); } args = e+1; o_cast(float_type_string, PIKE_T_FLOAT); /* Now all the values should be floats. */ goto tail_recurse;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  }
09cae22003-11-12Martin Stjernholm #define ADD_WITH_UNDEFINED(TYPE, T_TYPEID, ADD_FUNC, PUSH_FUNC) do { \ int e; \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) == T_INT) { \
09cae22003-11-12Martin Stjernholm  if(IS_UNDEFINED(sp-args)) \ { \ struct TYPE *x; \ \ for(e=1;e<args;e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_TYPEID) \
09cae22003-11-12Martin Stjernholm  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++) \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[e-args]) != T_INT) \
09cae22003-11-12Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR("`+", e+1, "int"); \ } \ \ else { \ for(e=1;e<args;e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[e-args]) != T_TYPEID) \
09cae22003-11-12Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR("`+", e+1, #TYPE); \ } \ \ DO_IF_DEBUG (Pike_fatal ("Shouldn't be reached.\n")); \
14f5d82009-08-12Henrik Grubbström (Grubba)  break; \
09cae22003-11-12Martin Stjernholm  } while (0)
ee37801999-02-09Fredrik Hübinette (Hubbe) 
09cae22003-11-12Martin Stjernholm #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);
ee37801999-02-09Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case BIT_ARRAY:
09cae22003-11-12Martin Stjernholm  ADD (array, add_arrays, push_array);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
482fb51999-03-12Per Hedbor  case BIT_MAPPING|BIT_INT:
09cae22003-11-12Martin Stjernholm  ADD_WITH_UNDEFINED (mapping, T_MAPPING, add_mappings, push_mapping);
482fb51999-03-12Per Hedbor 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case BIT_MAPPING:
09cae22003-11-12Martin Stjernholm  ADD (mapping, add_mappings, push_mapping);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
09cae22003-11-12Martin Stjernholm  case BIT_MULTISET|BIT_INT: ADD_WITH_UNDEFINED (multiset, T_MULTISET, add_multisets, push_multiset);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
06983f1996-09-22Fredrik Hübinette (Hubbe)  case BIT_MULTISET:
09cae22003-11-12Martin Stjernholm  ADD (multiset, add_multisets, push_multiset);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
09cae22003-11-12Martin Stjernholm #undef ADD_WITH_UNDEFINED #undef ADD
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) static int generate_sum(node *n) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
204a5a2004-08-24Henrik Grubbström (Grubba)  node **first_arg, **second_arg, **third_arg;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  switch(count_args(CDR(n))) {
204a5a2004-08-24Henrik Grubbström (Grubba)  case 0: return 0;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: do_docode(CDR(n),0); return 1; case 2:
a2b70a2000-04-30Fredrik Hübinette (Hubbe)  first_arg=my_get_arg(&_CDR(n), 0); second_arg=my_get_arg(&_CDR(n), 1);
5e44422001-02-25Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
a2b70a2000-04-30Fredrik Hübinette (Hubbe)  if(first_arg[0]->type == float_type_string && second_arg[0]->type == float_type_string) { emit0(F_ADD_FLOATS); }
70a0f02004-08-25Henrik Grubbström (Grubba)  else if(first_arg[0]->type && second_arg[0]->type && pike_types_le(first_arg[0]->type, int_type_string) &&
29e7e42004-08-24Henrik Grubbström (Grubba)  pike_types_le(second_arg[0]->type, int_type_string))
a2b70a2000-04-30Fredrik Hübinette (Hubbe)  { emit0(F_ADD_INTS); } else { emit0(F_ADD); }
f4f8642008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1;
204a5a2004-08-24Henrik Grubbström (Grubba)  case 3: first_arg = my_get_arg(&_CDR(n), 0); second_arg = my_get_arg(&_CDR(n), 1); third_arg = my_get_arg(&_CDR(n), 2); if(first_arg[0]->type == float_type_string && second_arg[0]->type == float_type_string) { do_docode(*first_arg, 0); do_docode(*second_arg, 0); emit0(F_ADD_FLOATS);
f4f8642008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
204a5a2004-08-24Henrik Grubbström (Grubba)  if (third_arg[0]->type == float_type_string) { do_docode(*third_arg, 0); emit0(F_ADD_FLOATS);
f4f8642008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
204a5a2004-08-24Henrik Grubbström (Grubba)  return 1; } }
70a0f02004-08-25Henrik Grubbström (Grubba)  else if(first_arg[0]->type && second_arg[0]->type && pike_types_le(first_arg[0]->type, int_type_string) &&
204a5a2004-08-24Henrik Grubbström (Grubba)  pike_types_le(second_arg[0]->type, int_type_string)) { do_docode(*first_arg, 0); do_docode(*second_arg, 0); emit0(F_ADD_INTS);
f4f8642008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
70a0f02004-08-25Henrik Grubbström (Grubba)  if (third_arg[0]->type && pike_types_le(third_arg[0]->type, int_type_string)) {
204a5a2004-08-24Henrik Grubbström (Grubba)  do_docode(*third_arg, 0); emit0(F_ADD_INTS);
f4f8642008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
204a5a2004-08-24Henrik Grubbström (Grubba)  return 1; } } else { return 0; } do_docode(*third_arg, 0); emit0(F_ADD);
f4f8642008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
204a5a2004-08-24Henrik Grubbström (Grubba)  return 1;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  default: return 0; } }
e104411998-06-05Fredrik Hübinette (Hubbe) static node *optimize_eq(node *n) { node **first_arg, **second_arg, *ret; if(count_args(CDR(n))==2) {
f807f01999-11-11Henrik Grubbström (Grubba)  first_arg=my_get_arg(&_CDR(n), 0);
177c561999-11-11Henrik Grubbström (Grubba)  second_arg=my_get_arg(&_CDR(n), 1);
e104411998-06-05Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e104411998-06-05Fredrik Hübinette (Hubbe)  if(!first_arg || !second_arg)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Couldn't find argument!\n");
e104411998-06-05Fredrik Hübinette (Hubbe) #endif
01eb482011-03-05Martin Stjernholm 
ffa4522001-05-11Henrik Grubbström (Grubba)  if (((*second_arg)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF((*second_arg)->u.sval) == T_STRING) &&
408a1e2004-10-30Martin Stjernholm  ((*first_arg)->token == F_RANGE)) { node *low = CADR (*first_arg), *high = CDDR (*first_arg); INT_TYPE c; if ((low->token == F_RANGE_OPEN || (low->token == F_RANGE_FROM_BEG && (CAR (low)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CAR (low)->u.sval) == T_INT) &&
408a1e2004-10-30Martin Stjernholm  (!(CAR (low)->u.sval.u.integer)))) && (high->token == F_RANGE_OPEN || (high->token == F_RANGE_FROM_BEG && (CAR (high)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CAR (high)->u.sval) == T_INT) &&
408a1e2004-10-30Martin Stjernholm  (c = CAR (high)->u.sval.u.integer, 1)))) { /* str[..c] == "foo" or str[0..c] == "foo" or * str[..] == "foo" or str[0..] == "foo" */ if (high->token == F_RANGE_OPEN || (*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 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 { /* 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; }
ffa4522001-05-11Henrik Grubbström (Grubba)  } }
e104411998-06-05Fredrik Hübinette (Hubbe)  } return 0; } static node *optimize_not(node *n) { node **first_arg, **more_args; if(count_args(CDR(n))==1) {
f807f01999-11-11Henrik Grubbström (Grubba)  first_arg=my_get_arg(&_CDR(n), 0);
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e104411998-06-05Fredrik Hübinette (Hubbe)  if(!first_arg)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Couldn't find argument!\n");
e104411998-06-05Fredrik Hübinette (Hubbe) #endif if(node_is_true(*first_arg)) return mkintnode(0); if(node_is_false(*first_arg)) return mkintnode(1);
f807f01999-11-11Henrik Grubbström (Grubba) #define TMP_OPT(X,Y) do { \ if((more_args=is_call_to(*first_arg, X))) \ { \ node *tmp=*more_args; \
ea71c22000-11-11Fredrik Hübinette (Hubbe)  if(count_args(*more_args) > 2) return 0; \
01b2c21999-11-22Henrik Grubbström (Grubba)  ADD_NODE_REF(*more_args); \
f807f01999-11-11Henrik Grubbström (Grubba)  return mkopernode(Y,tmp,0); \ } } while(0)
e104411998-06-05Fredrik Hübinette (Hubbe)  TMP_OPT(f_eq, "`!="); TMP_OPT(f_ne, "`==");
f5971b2004-11-27Martin Stjernholm #if 0 /* The following only work on total orders. We can't assume that. */
e104411998-06-05Fredrik Hübinette (Hubbe)  TMP_OPT(f_lt, "`>="); TMP_OPT(f_gt, "`<="); TMP_OPT(f_le, "`>"); TMP_OPT(f_ge, "`<");
f5971b2004-11-27Martin Stjernholm #endif
e104411998-06-05Fredrik Hübinette (Hubbe) #undef TMP_OPT
89c4452000-04-12Henrik Grubbström (Grubba)  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) &&
a0c96c2007-03-20Henrik Grubbström (Grubba)  pike_types_le(CAR(search_args)->type, string_type_string) &&
89c4452000-04-12Henrik Grubbström (Grubba)  CDR(search_args) &&
a0c96c2007-03-20Henrik Grubbström (Grubba)  pike_types_le(CDR(search_args)->type, string_type_string)) {
89c4452000-04-12Henrik Grubbström (Grubba)  /* !search(string a, string b) => has_prefix(a, b) */ ADD_NODE_REF(*more_args); return mkefuncallnode("has_prefix", search_args); } }
e104411998-06-05Fredrik Hübinette (Hubbe)  } return 0; }
9d4cae2002-06-17Henrik Grubbström (Grubba) static node *may_have_side_effects(node *n) { node **arg; int argno; for (argno = 0; (arg = my_get_arg(&_CDR(n), argno)); argno++) {
9403422010-11-18Henrik Grubbström (Grubba)  if (((*arg)->type != zero_type_string) && match_types(object_type_string, (*arg)->type)) {
9d4cae2002-06-17Henrik Grubbström (Grubba)  n->node_info |= OPT_SIDE_EFFECT; n->tree_info |= OPT_SIDE_EFFECT; return NULL; } } return NULL; }
e104411998-06-05Fredrik Hübinette (Hubbe) 
6930181996-02-25Fredrik Hübinette (Hubbe) static node *optimize_binary(node *n) { node **first_arg, **second_arg, *ret;
a0c96c2007-03-20Henrik Grubbström (Grubba)  int args; if((args = count_args(CDR(n)))==2)
6930181996-02-25Fredrik Hübinette (Hubbe)  {
f807f01999-11-11Henrik Grubbström (Grubba)  first_arg=my_get_arg(&_CDR(n), 0); second_arg=my_get_arg(&_CDR(n), 1);
6930181996-02-25Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
6930181996-02-25Fredrik Hübinette (Hubbe)  if(!first_arg || !second_arg)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Couldn't find argument!\n");
6930181996-02-25Fredrik Hübinette (Hubbe) #endif
bce86c1996-02-25Fredrik Hübinette (Hubbe)  if((*second_arg)->type == (*first_arg)->type && compile_type_to_runtime_type((*second_arg)->type) != T_MIXED)
6930181996-02-25Fredrik Hübinette (Hubbe)  { if((*first_arg)->token == F_APPLY && CAR(*first_arg)->token == F_CONSTANT && is_eq(& CAR(*first_arg)->u.sval, & CAR(n)->u.sval)) {
204a5a2004-08-24Henrik Grubbström (Grubba)  /* binop(binop(@a_args), b) ==> binop(@a_args, b) */
8f2fa42000-10-03Henrik Grubbström (Grubba)  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)) )));
6930181996-02-25Fredrik Hübinette (Hubbe)  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)) {
204a5a2004-08-24Henrik Grubbström (Grubba)  /* binop(a, binop(@b_args)) ==> binop(a, @b_args) */
8f2fa42000-10-03Henrik Grubbström (Grubba)  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))) )));
6930181996-02-25Fredrik Hübinette (Hubbe)  return ret; } } }
a0c96c2007-03-20Henrik Grubbström (Grubba) #if 0 /* Does not work for multiplication. */ /* Strengthen the string type. */ if (n->type && (n->type->type == T_STRING) && CAR_TO_INT(n->type) == 32 && (args > 0)) { int str_width = 6; /* Width generated in int and float conversions. */ while (args--) { struct pike_type *t; node **arg = my_get_arg(&_CDR(n), args); if (!arg || !(t = (*arg)->type)) continue; if (t->type == T_STRING) { int w = CAR_TO_INT(t); if (w > str_width) str_width = w; } } if (str_width != 32) { type_stack_mark();
7a1c052007-05-03Henrik Grubbström (Grubba)  push_int_type(0, (1<<str_width)-1); push_type(T_STRING);
a0c96c2007-03-20Henrik Grubbström (Grubba)  free_type(n->type); n->type = pop_unfinished_type(); } } #endif /* 0 */
6930181996-02-25Fredrik Hübinette (Hubbe)  return 0; }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) static int generate_comparison(node *n) { if(count_args(CDR(n))==2) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
4c573c1996-08-03Fredrik Hübinette (Hubbe)  if(do_docode(CDR(n),DO_NOT_COPY) != 2)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Count args was wrong in generate_comparison.\n");
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  if(CAR(n)->u.sval.u.efun->function == f_eq)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_EQ);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_ne)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_NE);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_lt)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_LT);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_le)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_LE);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_gt)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_GT);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_ge)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_GE);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else
80ee912006-03-25Henrik Grubbström (Grubba)  Pike_fatal("Couldn't generate comparison!\n" "efun->function: %p\n" "f_eq: %p\n" "f_ne: %p\n" "f_lt: %p\n" "f_le: %p\n" "f_gt: %p\n" "f_ge: %p\n", CAR(n)->u.sval.u.efun->function, f_eq, f_ne, f_lt, f_le, f_gt, f_ge);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
be478c1997-08-30Henrik Grubbström (Grubba) static int float_promote(void)
bce86c1996-02-25Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) == T_INT && TYPEOF(sp[-1]) == T_FLOAT)
bce86c1996-02-25Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_FLOAT, 0, float_number, (FLOAT_TYPE)sp[-2].u.integer);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 1;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  }
017b572011-10-28Henrik Grubbström (Grubba)  else if(TYPEOF(sp[-1]) == T_INT && TYPEOF(sp[-2]) == T_FLOAT)
bce86c1996-02-25Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_FLOAT, 0, float_number, (FLOAT_TYPE)sp[-1].u.integer);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 1; }
e924491999-12-14Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if(is_bignum_object_in_svalue(sp-2) && TYPEOF(sp[-1]) == T_FLOAT)
e924491999-12-14Fredrik Hübinette (Hubbe)  { stack_swap();
b103b32001-02-20Henrik Grubbström (Grubba)  ref_push_type_value(float_type_string);
e924491999-12-14Fredrik Hübinette (Hubbe)  stack_swap(); f_cast(); stack_swap(); return 1; }
017b572011-10-28Henrik Grubbström (Grubba)  else if(is_bignum_object_in_svalue(sp-1) && TYPEOF(sp[-2]) == T_FLOAT)
e924491999-12-14Fredrik Hübinette (Hubbe)  {
b103b32001-02-20Henrik Grubbström (Grubba)  ref_push_type_value(float_type_string);
e924491999-12-14Fredrik Hübinette (Hubbe)  stack_swap(); f_cast(); return 1; }
84ca422013-06-17Martin Nilsson 
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 0; } static int call_lfun(int left, int right) {
9793b72004-12-18Henrik Grubbström (Grubba)  struct object *o; struct program *p;
33c9582003-11-10Martin Stjernholm  int i;
9793b72004-12-18Henrik Grubbström (Grubba) 
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) == T_OBJECT &&
9793b72004-12-18Henrik Grubbström (Grubba)  (p = (o = sp[-2].u.object)->prog) &&
017b572011-10-28Henrik Grubbström (Grubba)  (i = FIND_LFUN(p->inherits[SUBTYPEOF(sp[-2])].prog, left)) != -1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  free_svalue(sp-2); sp[-2]=sp[-1]; sp--;
41e2cb1999-10-24Henrik Grubbström (Grubba)  dmalloc_touch_svalue(sp);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 1;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_OBJECT &&
9793b72004-12-18Henrik Grubbström (Grubba)  (p = (o = sp[-1].u.object)->prog) &&
017b572011-10-28Henrik Grubbström (Grubba)  (i = FIND_LFUN(p->inherits[SUBTYPEOF(sp[-1])].prog, right)) != -1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  { push_svalue(sp-2);
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  free_svalue(sp-3); sp[-3]=sp[-1]; sp--;
41e2cb1999-10-24Henrik Grubbström (Grubba)  dmalloc_touch_svalue(sp);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  pop_stack(); return 1; } return 0;
bce86c1996-02-25Fredrik Hübinette (Hubbe) }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
aa17e32000-04-12Mirar (Pontus Hagland) 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);
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_subtract(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-2]) != TYPEOF(sp[-1]) && !float_promote())
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  { if(call_lfun(LFUN_SUBTRACT, LFUN_RSUBTRACT)) return;
aa17e32000-04-12Mirar (Pontus Hagland) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-2]) == T_MAPPING) switch (TYPEOF(sp[-1]))
aa17e32000-04-12Mirar (Pontus Hagland)  { 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;
5b15bb2001-12-10Martin Stjernholm  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);
aa17e32000-04-12Mirar (Pontus Hagland)  pop_n_elems(2); push_mapping(m); return; } }
017b572011-10-28Henrik Grubbström (Grubba)  bad_arg_error("`-", sp-2, 2, 2, get_name_of_type(TYPEOF(sp[-2])),
54db6c1999-03-27Henrik Grubbström (Grubba)  sp-1, "Subtract on different types.\n");
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_SUBTRACT,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping,PIKE_ARRAY_OP_SUB);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_mapping(m); return; }
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct multiset *l;
eba42b2008-07-08Henrik Grubbström (Grubba)  if (sp[-2].u.multiset->refs == 1) { l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_SUB | PIKE_MERGE_DESTR_A); } else { l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_SUB); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2);
06983f1996-09-22Fredrik Hübinette (Hubbe)  push_multiset(l);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; } case T_FLOAT: sp--; sp[-1].u.float_number -= sp[0].u.float_number; return; case T_INT:
ff0d461999-10-15Fredrik Noring  if(INT_TYPE_SUB_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer)) { convert_stack_top_to_bignum(); f_minus(2); return; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], PIKE_T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer - sp[0].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; case T_STRING: {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s,*ret;
5267b71995-08-09Fredrik Hübinette (Hubbe)  s=make_shared_string("");
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  ret=string_replace(sp[-2].u.string,sp[-1].u.string,s); free_string(sp[-2].u.string);
5267b71995-08-09Fredrik Hübinette (Hubbe)  free_string(sp[-1].u.string); free_string(s);
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  sp[-2].u.string=ret; sp--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
33c9582003-11-10Martin Stjernholm  /* FIXME: Support types? */
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
54db6c1999-03-27Henrik Grubbström (Grubba)  { int args = 2; SIMPLE_BAD_ARG_ERROR("`-", 1, "int|float|string|mapping|multiset|array|object"); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @decl mixed `-(mixed arg1)
dfceb02003-11-10Martin Stjernholm  *! @decl mixed `-(mixed arg1, mixed arg2, mixed ... extras)
f09ec92001-02-07Henrik Grubbström (Grubba)  *! @decl mixed `-(object arg1, mixed arg2)
dfceb02003-11-10Martin Stjernholm  *! @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)
f09ec92001-02-07Henrik Grubbström (Grubba)  *! @decl mapping `-(mapping arg1, array arg2) *! @decl mapping `-(mapping arg1, mapping arg2)
dfceb02003-11-10Martin Stjernholm  *! @decl mapping `-(mapping arg1, multiset arg2)
f09ec92001-02-07Henrik Grubbström (Grubba)  *! @decl multiset `-(multiset arg1, multiset arg2) *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns
dfceb02003-11-10Martin Stjernholm  *! 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.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! If there are more than two arguments the result is:
f79bd82003-04-01Martin Nilsson  *! @expr{`-(`-(@[arg1], @[arg2]), @@@[extras])@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg1] is an object with an @[lfun::`-()], that *! function is called with @[arg2] as argument, and its result is *! returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg2] is an object with an @[lfun::``-()], that *! function is called with @[arg1] as argument, and its result is *! returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise the result depends on the argument types:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
dfceb02003-11-10Martin Stjernholm  *! @type int|float *! The result is @expr{@[arg1] - @[arg2]@}, and is a float if *! either @[arg1] or @[arg2] is a float.
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type string
dfceb02003-11-10Martin Stjernholm  *! 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]).
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @note *! In Pike 7.0 and earlier the subtraction order was unspecified. *! *! @seealso *! @[`+()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_minus(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
54db6c1999-03-27Henrik Grubbström (Grubba)  case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`-", 1);
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  case 1: o_negate(); break; case 2: o_subtract(); break; default: { INT32 e;
8496b22011-04-09Henrik Grubbström (Grubba)  TYPE_FIELD types = 0;
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  struct svalue *s=sp-args;
8496b22011-04-09Henrik Grubbström (Grubba) 
017b572011-10-28Henrik Grubbström (Grubba)  for(e=-args;e<0;e++) types |= 1<<TYPEOF(sp[e]);
8496b22011-04-09Henrik Grubbström (Grubba)  if ((types | BIT_INT | BIT_FLOAT) == (BIT_INT | BIT_FLOAT)) {
5c22db2011-04-09Henrik Grubbström (Grubba)  INT32 carry = 0; if (types == BIT_INT) { f_add(args-1); o_subtract(); break; }
8496b22011-04-09Henrik Grubbström (Grubba)  /* Take advantage of the precision control in f_add(). */
5c22db2011-04-09Henrik Grubbström (Grubba)  for(e = 1; e < args; e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(s[e]) == PIKE_T_INT) {
5c22db2011-04-09Henrik Grubbström (Grubba)  INT_TYPE val = s[e].u.integer; if (val >= -0x7fffffff) { s[e].u.integer = -val; } else { /* Protect against negative overflow. */ s[e].u.integer = ~val; carry++; } } else { s[e].u.float_number = -s[e].u.float_number; } } if (carry) { push_int(carry); args++; } f_add(args);
8496b22011-04-09Henrik Grubbström (Grubba)  break; }
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  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); }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  } } static int generate_minus(node *n)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  switch(count_args(CDR(n))) { case 1: do_docode(CDR(n),DO_NOT_COPY);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_NEGATE);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; case 2:
5e44422001-02-25Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_SUBTRACT);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_and(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != TYPEOF(sp[-2]))
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
aa17e32000-04-12Mirar (Pontus Hagland)  if(call_lfun(LFUN_AND, LFUN_RAND)) return;
017b572011-10-28Henrik Grubbström (Grubba)  else if (((TYPEOF(sp[-1]) == T_TYPE) || (TYPEOF(sp[-1]) == T_PROGRAM) || (TYPEOF(sp[-1]) == T_FUNCTION)) && ((TYPEOF(sp[-2]) == T_TYPE) || (TYPEOF(sp[-2]) == T_PROGRAM) || (TYPEOF(sp[-2]) == T_FUNCTION)))
aa17e32000-04-12Mirar (Pontus Hagland)  {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-2]) != T_TYPE)
aa17e32000-04-12Mirar (Pontus Hagland)  { struct program *p = program_from_svalue(sp - 2); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`&", 1, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
aa17e32000-04-12Mirar (Pontus Hagland)  free_svalue(sp - 2);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_TYPE)
aa17e32000-04-12Mirar (Pontus Hagland)  { struct program *p = program_from_svalue(sp - 1); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`&", 2, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
aa17e32000-04-12Mirar (Pontus Hagland)  free_svalue(sp - 1);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
aa17e32000-04-12Mirar (Pontus Hagland)  }
017b572011-10-28Henrik Grubbström (Grubba)  else if (TYPEOF(sp[-2]) == T_MAPPING) switch (TYPEOF(sp[-1]))
aa17e32000-04-12Mirar (Pontus Hagland)  { 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;
5b15bb2001-12-10Martin Stjernholm  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);
aa17e32000-04-12Mirar (Pontus Hagland)  pop_n_elems(2); push_mapping(m); return; }
eed2da2001-06-11Henrik Grubbström (Grubba)  default: { int args = 2; SIMPLE_BAD_ARG_ERROR("`&", 2, "mapping"); }
aa17e32000-04-12Mirar (Pontus Hagland)  } else { int args = 2;
017b572011-10-28Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`&", 2, get_name_of_type(TYPEOF(sp[-2])));
aa17e32000-04-12Mirar (Pontus Hagland)  }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_AND,2); break;
fc0bb51997-02-13Niels Möller 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT: sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], PIKE_T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer & sp[0].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING: { struct mapping *m;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping, PIKE_ARRAY_OP_AND);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_mapping(m); return; }
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct multiset *l;
eba42b2008-07-08Henrik Grubbström (Grubba)  if (sp[-2].u.multiset->refs == 1) { l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_AND | PIKE_MERGE_DESTR_A); } else { l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_AND); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2);
06983f1996-09-22Fredrik Hübinette (Hubbe)  push_multiset(l);
5267b71995-08-09Fredrik Hübinette (Hubbe)  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; }
fc0bb51997-02-13Niels Möller 
3db0d21999-12-13Henrik Grubbström (Grubba)  case T_TYPE: {
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *t; t = and_pike_types(sp[-2].u.type, sp[-1].u.type);
3db0d21999-12-13Henrik Grubbström (Grubba)  pop_n_elems(2);
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(t);
3db0d21999-12-13Henrik Grubbström (Grubba)  return; }
dc7d491999-12-15Henrik Grubbström (Grubba)  case T_FUNCTION: case T_PROGRAM: { struct program *p;
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *a; struct pike_type *b; struct pike_type *t;
dc7d491999-12-15Henrik Grubbström (Grubba)  p = program_from_svalue(sp - 2); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`&", 1, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  a = pop_unfinished_type(); p = program_from_svalue(sp - 1); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`&", 2, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  b = pop_unfinished_type(); t = and_pike_types(a, b); pop_n_elems(2);
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(t); free_type(a); free_type(b);
dc7d491999-12-15Henrik Grubbström (Grubba)  return; }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) #define STRING_BITOP(OP,STROP) \ case T_STRING: \ { \
6f90302013-08-25Arne Goedeke  struct pike_string *s; \
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t len, i; \
6f90302013-08-25Arne Goedeke  \ len = sp[-2].u.string->len; \ if (len != sp[-1].u.string->len) \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  PIKE_ERROR("`" #OP, "Bitwise "STROP \ " on strings of different lengths.\n", sp, 2); \
6f90302013-08-25Arne Goedeke  if(!sp[-2].u.string->size_shift && !sp[-1].u.string->size_shift) \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  { \ s = begin_shared_string(len); \ for (i=0; i<len; i++) \
6f90302013-08-25Arne Goedeke  s->str[i] = sp[-2].u.string->str[i] OP sp[-1].u.string->str[i]; \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  }else{ \ s = begin_wide_shared_string(len, \
6f90302013-08-25Arne Goedeke  MAXIMUM(sp[-2].u.string->size_shift, \ sp[-1].u.string->size_shift)); \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  for (i=0; i<len; i++) \
6f90302013-08-25Arne Goedeke  low_set_index(s,i,index_shared_string(sp[-2].u.string,i) OP \ index_shared_string(sp[-1].u.string,i)); \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  } \ pop_n_elems(2); \
6f90302013-08-25Arne Goedeke  push_string(end_shared_string(s)); \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  return; \ } STRING_BITOP(&,"AND")
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
fd95012002-12-12Martin Nilsson  PIKE_ERROR("`&", "Bitwise AND on illegal type.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
3c04e81997-03-13Fredrik Hübinette (Hubbe) /* 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. */
adbb781998-09-18Fredrik Hübinette (Hubbe) 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);
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
adbb781998-09-18Fredrik Hübinette (Hubbe)  tmp=*--sp; SET_ONERROR(err,do_free_svalue,&tmp); r_speedup(args>>1,func); UNSET_ONERROR(err); sp++[0]=tmp; func(); } }
3c04e81997-03-13Fredrik Hübinette (Hubbe) static void speedup(INT32 args, void (*func)(void)) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-args]))
3c04e81997-03-13Fredrik Hübinette (Hubbe)  {
c2769b1999-10-01Fredrik Hübinette (Hubbe)  /* Binary balanced tree method for types where * a op b may or may not be equal to b op a */ case T_ARRAY:
adbb781998-09-18Fredrik Hübinette (Hubbe)  case T_MAPPING: r_speedup(args,func); return;
3c04e81997-03-13Fredrik Hübinette (Hubbe) 
adbb781998-09-18Fredrik Hübinette (Hubbe)  default: while(--args > 0) func();
3c04e81997-03-13Fredrik Hübinette (Hubbe)  } }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @decl mixed `&(mixed arg1)
dfceb02003-11-10Martin Stjernholm  *! @decl mixed `&(mixed arg1, mixed arg2, mixed ... extras)
f09ec92001-02-07Henrik Grubbström (Grubba)  *! @decl mixed `&(object arg1, mixed arg2) *! @decl mixed `&(mixed arg1, object arg2) *! @decl int `&(int arg1, int arg2)
dfceb02003-11-10Martin Stjernholm  *! @decl string `&(string arg1, string arg2)
f09ec92001-02-07Henrik Grubbström (Grubba)  *! @decl array `&(array arg1, array arg2) *! @decl mapping `&(mapping arg1, mapping arg2) *! @decl mapping `&(mapping arg1, array arg2) *! @decl mapping `&(mapping arg1, multiset arg2)
dfceb02003-11-10Martin Stjernholm  *! @decl multiset `&(multiset arg1, multiset arg2) *! @decl type `&(type|program arg1, type|program arg2) *! *! Bitwise and/intersection.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
dfceb02003-11-10Martin Stjernholm  *! If there's a single argument, that argument is returned.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! If there are more than two arguments the result is:
f79bd82003-04-01Martin Nilsson  *! @expr{`&(`&(@[arg1], @[arg2]), @@@[extras])@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg1] is an object with an @[lfun::`&()], that *! function is called with @[arg2] as argument, and its result is *! returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type int
dfceb02003-11-10Martin Stjernholm  *! Bitwise and of @[arg1] and @[arg2].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type string
dfceb02003-11-10Martin Stjernholm  *! 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].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @seealso *! @[`|()], @[lfun::`&()], @[lfun::``&()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_and(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
54db6c1999-03-27Henrik Grubbström (Grubba)  case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`&", 1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: return; case 2: o_and(); return;
07c0731996-06-21Fredrik Hübinette (Hubbe)  default:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) == T_OBJECT)
07c0731996-06-21Fredrik Hübinette (Hubbe)  { CALL_OPERATOR(LFUN_AND, args); }else{
3c04e81997-03-13Fredrik Hübinette (Hubbe)  speedup(args, o_and);
07c0731996-06-21Fredrik Hübinette (Hubbe)  }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  } } static int generate_and(node *n)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  switch(count_args(CDR(n))) { case 1: do_docode(CDR(n),0); return 1; case 2: do_docode(CDR(n),0);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_AND);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; default: return 0; } }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_or(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != TYPEOF(sp[-2]))
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
dc7d491999-12-15Henrik Grubbström (Grubba)  if(call_lfun(LFUN_OR, LFUN_ROR)) {
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return;
017b572011-10-28Henrik Grubbström (Grubba)  } else if (((TYPEOF(sp[-1]) == T_TYPE) || (TYPEOF(sp[-1]) == T_PROGRAM) || (TYPEOF(sp[-1]) == T_FUNCTION)) && ((TYPEOF(sp[-2]) == T_TYPE) || (TYPEOF(sp[-2]) == T_PROGRAM) || (TYPEOF(sp[-2]) == T_FUNCTION))) { if (TYPEOF(sp[-2]) != T_TYPE) {
dc7d491999-12-15Henrik Grubbström (Grubba)  struct program *p = program_from_svalue(sp - 2); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`|", 1, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  free_svalue(sp - 2);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_TYPE) {
dc7d491999-12-15Henrik Grubbström (Grubba)  struct program *p = program_from_svalue(sp - 1); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`|", 2, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  free_svalue(sp - 1);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  } } else {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 2;
017b572011-10-28Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`|", 2, get_name_of_type(TYPEOF(sp[-2])));
54db6c1999-03-27Henrik Grubbström (Grubba)  }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_OR,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT: sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer | sp[0].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING: { struct mapping *m;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping, PIKE_ARRAY_OP_OR);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_mapping(m); return; }
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct multiset *l;
eba42b2008-07-08Henrik Grubbström (Grubba)  if (sp[-2].u.multiset->refs == 1) { l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_OR_LEFT | PIKE_MERGE_DESTR_A); } else { l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_OR_LEFT); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2);
06983f1996-09-22Fredrik Hübinette (Hubbe)  push_multiset(l);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; } case T_ARRAY: {
5768c22009-09-07Henrik Grubbström (Grubba)  if (sp[-1].u.array->size == 1) { /* Common case (typically the |= operator). */ int i = array_search(sp[-2].u.array, sp[-1].u.array->item, 0); if (i == -1) { f_add(2); } else { pop_stack(); } } else if ((sp[-2].u.array == sp[-1].u.array) && (sp[-1].u.array->refs == 2)) { /* Not common, but easy to detect... */ pop_stack(); } else { 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); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
3db0d21999-12-13Henrik Grubbström (Grubba)  case T_TYPE: {
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *t; t = or_pike_types(sp[-2].u.type, sp[-1].u.type, 0);
3db0d21999-12-13Henrik Grubbström (Grubba)  pop_n_elems(2);
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(t);
3db0d21999-12-13Henrik Grubbström (Grubba)  return; }
dc7d491999-12-15Henrik Grubbström (Grubba)  case T_FUNCTION: case T_PROGRAM: { struct program *p;
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *a; struct pike_type *b; struct pike_type *t;
dc7d491999-12-15Henrik Grubbström (Grubba)  p = program_from_svalue(sp - 2); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`|", 1, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  a = pop_unfinished_type(); p = program_from_svalue(sp - 1); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`|", 2, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  b = pop_unfinished_type(); t = or_pike_types(a, b, 0); pop_n_elems(2);
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(t); free_type(a); free_type(b);
dc7d491999-12-15Henrik Grubbström (Grubba)  return; }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  STRING_BITOP(|,"OR")
fc0bb51997-02-13Niels Möller 
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
fd95012002-12-12Martin Nilsson  PIKE_ERROR("`|", "Bitwise OR on illegal type.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
b90e552001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `|(mixed arg1)
dfceb02003-11-10Martin Stjernholm  *! @decl mixed `|(mixed arg1, mixed arg2, mixed ... extras)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mixed `|(object arg1, mixed arg2) *! @decl mixed `|(mixed arg1, object arg2) *! @decl int `|(int arg1, int arg2)
dfceb02003-11-10Martin Stjernholm  *! @decl string `|(string arg1, string arg2) *! @decl array `|(array arg1, array arg2)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mapping `|(mapping arg1, mapping arg2) *! @decl multiset `|(multiset arg1, multiset arg2) *! @decl type `|(program|type arg1, program|type arg2) *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
dfceb02003-11-10Martin Stjernholm  *! If there's a single argument, that argument is returned.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! If there are more than two arguments, the result is:
f79bd82003-04-01Martin Nilsson  *! @expr{`|(`|(@[arg1], @[arg2]), @@@[extras])@}.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg1] is an object with an @[lfun::`|()], that *! function is called with @[arg2] as argument, and its result is *! returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
dfceb02003-11-10Martin Stjernholm  *! @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].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
b90e552001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[`&()], @[lfun::`|()], @[lfun::``|()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_or(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
54db6c1999-03-27Henrik Grubbström (Grubba)  case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`|", 1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: return; case 2: o_or(); return;
07c0731996-06-21Fredrik Hübinette (Hubbe)  default:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) == T_OBJECT)
07c0731996-06-21Fredrik Hübinette (Hubbe)  { CALL_OPERATOR(LFUN_OR, args); } else {
3c04e81997-03-13Fredrik Hübinette (Hubbe)  speedup(args, o_or);
07c0731996-06-21Fredrik Hübinette (Hubbe)  }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  } } static int generate_or(node *n)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  switch(count_args(CDR(n))) { case 1: do_docode(CDR(n),0); return 1; case 2: do_docode(CDR(n),0);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_OR);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; default: return 0; } }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_xor(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != TYPEOF(sp[-2]))
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
dc7d491999-12-15Henrik Grubbström (Grubba)  if(call_lfun(LFUN_XOR, LFUN_RXOR)) {
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return;
017b572011-10-28Henrik Grubbström (Grubba)  } else if (((TYPEOF(sp[-1]) == T_TYPE) || (TYPEOF(sp[-1]) == T_PROGRAM) || (TYPEOF(sp[-1]) == T_FUNCTION)) && ((TYPEOF(sp[-2]) == T_TYPE) || (TYPEOF(sp[-2]) == T_PROGRAM) || (TYPEOF(sp[-2]) == T_FUNCTION))) { if (TYPEOF(sp[-2]) != T_TYPE) {
dc7d491999-12-15Henrik Grubbström (Grubba)  struct program *p = program_from_svalue(sp - 2); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`^", 1, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  free_svalue(sp - 2);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_TYPE) {
dc7d491999-12-15Henrik Grubbström (Grubba)  struct program *p = program_from_svalue(sp - 1); if (!p) { int args = 2; SIMPLE_BAD_ARG_ERROR("`^", 2, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  free_svalue(sp - 1);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  } } else {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 2;
017b572011-10-28Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`^", 2, get_name_of_type(TYPEOF(sp[-2])));
54db6c1999-03-27Henrik Grubbström (Grubba)  }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_XOR,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT: sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer ^ sp[0].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING: { struct mapping *m;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping, PIKE_ARRAY_OP_XOR);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_mapping(m); return; }
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct multiset *l;
eba42b2008-07-08Henrik Grubbström (Grubba)  if (sp[-2].u.multiset->refs == 1) { l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_XOR | PIKE_MERGE_DESTR_A); } else { l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_XOR); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2);
06983f1996-09-22Fredrik Hübinette (Hubbe)  push_multiset(l);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; } case T_ARRAY: { struct array *a;
7b1a741999-08-14Fredrik Hübinette (Hubbe)  a=merge_array_with_order(sp[-2].u.array, sp[-1].u.array, PIKE_ARRAY_OP_XOR);
c1d3f21999-08-16Fredrik Hübinette (Hubbe)  pop_n_elems(2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  push_array(a); return; }
fc0bb51997-02-13Niels Möller 
dc7d491999-12-15Henrik Grubbström (Grubba)  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();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  pop_stack();
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  stack_swap(); p = program_from_svalue(sp - 1); if (!p) { int args = 2; stack_swap(); SIMPLE_BAD_ARG_ERROR("`^", 1, "type"); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  pop_stack();
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  } /* FALL_THROUGH */
3db0d21999-12-13Henrik Grubbström (Grubba)  case T_TYPE: {
0e801c1999-12-13Henrik Grubbström (Grubba)  /* a ^ b == (a&~b)|(~a&b) */
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *a; struct pike_type *b;
be6fec2001-04-01Henrik Grubbström (Grubba)  copy_pike_type(a, sp[-2].u.type); copy_pike_type(b, sp[-1].u.type);
0e801c1999-12-13Henrik Grubbström (Grubba)  o_compl(); /* ~b */ o_and(); /* a&~b */
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(a);
0e801c1999-12-13Henrik Grubbström (Grubba)  o_compl(); /* ~a */
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(b);
0e801c1999-12-13Henrik Grubbström (Grubba)  o_and(); /* ~a&b */ o_or(); /* (a&~b)|(~a&b) */
3db0d21999-12-13Henrik Grubbström (Grubba)  return; }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  STRING_BITOP(^,"XOR")
fc0bb51997-02-13Niels Möller 
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`^", "Bitwise XOR on illegal type.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
b90e552001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `^(mixed arg1)
dfceb02003-11-10Martin Stjernholm  *! @decl mixed `^(mixed arg1, mixed arg2, mixed ... extras)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mixed `^(object arg1, mixed arg2) *! @decl mixed `^(mixed arg1, object arg2) *! @decl int `^(int arg1, int arg2)
dfceb02003-11-10Martin Stjernholm  *! @decl string `^(string arg1, string arg2) *! @decl array `^(array arg1, array arg2)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mapping `^(mapping arg1, mapping arg2) *! @decl multiset `^(multiset arg1, multiset arg2) *! @decl type `^(program|type arg1, program|type arg2) *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
dfceb02003-11-10Martin Stjernholm  *! If there's a single argument, that argument is returned.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! If there are more than two arguments, the result is:
f79bd82003-04-01Martin Nilsson  *! @expr{`^(`^(@[arg1], @[arg2]), @@@[extras])@}.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg1] is an object with an @[lfun::`^()], that *! function is called with @[arg2] as argument, and its result is *! returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
dfceb02003-11-10Martin Stjernholm  *! @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:
9fcd242002-05-31Martin Nilsson  *! @expr{(@[arg1]&~@[arg2])|(~@[arg1]&@[arg2])@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
b90e552001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[`&()], @[`|()], @[lfun::`^()], @[lfun::``^()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_xor(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
54db6c1999-03-27Henrik Grubbström (Grubba)  case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`^", 1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: return; case 2: o_xor(); return;
07c0731996-06-21Fredrik Hübinette (Hubbe)  default:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) == T_OBJECT)
07c0731996-06-21Fredrik Hübinette (Hubbe)  { CALL_OPERATOR(LFUN_XOR, args); } else {
3c04e81997-03-13Fredrik Hübinette (Hubbe)  speedup(args, o_xor);
07c0731996-06-21Fredrik Hübinette (Hubbe)  }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  } } static int generate_xor(node *n) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  switch(count_args(CDR(n))) { case 1: do_docode(CDR(n),0); return 1; case 2: do_docode(CDR(n),0);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_XOR);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; default: return 0; } }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_lsh(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(sp[-1]) == T_INT) && (TYPEOF(sp[-2]) == T_INT) &&
c214f42002-06-17Henrik Grubbström (Grubba)  INT_TYPE_LSH_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer))
ff0d461999-10-15Fredrik Noring  convert_stack_top_to_bignum();
84ca422013-06-17Martin Nilsson 
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_INT || TYPEOF(sp[-2]) != T_INT)
07c0731996-06-21Fredrik Hübinette (Hubbe)  {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 2;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(call_lfun(LFUN_LSH, LFUN_RLSH))
07c0731996-06-21Fredrik Hübinette (Hubbe)  return;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) != T_INT)
9662312002-08-02Johan Sundström  SIMPLE_BAD_ARG_ERROR("`<<", 1, "int|object");
b019632002-10-15Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`<<", 2, "int(0..)|object");
07c0731996-06-21Fredrik Hübinette (Hubbe)  }
84ca422013-06-17Martin Nilsson 
b019632002-10-15Henrik Grubbström (Grubba)  if (sp[-1].u.integer < 0) {
66c9392002-10-15Henrik Grubbström (Grubba)  int args = 2;
b019632002-10-15Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`<<", 2, "int(0..)|object"); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer << sp->u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
b90e552001-02-08Henrik Grubbström (Grubba) /*! @decl int `<<(int arg1, int arg2) *! @decl mixed `<<(object arg1, int|object arg2) *! @decl mixed `<<(int arg1, object arg2)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg1] is an object that implements @[lfun::`<<()], that *! function will be called with @[arg2] as the single argument.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg2] is an object that implements @[lfun::``<<()], that *! function will be called with @[arg1] as the single argument.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! Otherwise @[arg1] will be shifted @[arg2] bits left.
b90e552001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[`>>()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_lsh(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
54db6c1999-03-27Henrik Grubbström (Grubba)  if(args != 2) { /* FIXME: Not appropriate if too many args. */ SIMPLE_TOO_FEW_ARGS_ERROR("`<<", 2); }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  o_lsh(); } static int generate_lsh(node *n) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  if(count_args(CDR(n))==2) {
5e44422001-02-25Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_LSH);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_rsh(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) != T_INT || TYPEOF(sp[-1]) != T_INT)
07c0731996-06-21Fredrik Hübinette (Hubbe)  {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 2;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(call_lfun(LFUN_RSH, LFUN_RRSH))
07c0731996-06-21Fredrik Hübinette (Hubbe)  return;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) != T_INT)
9662312002-08-02Johan Sundström  SIMPLE_BAD_ARG_ERROR("`>>", 1, "int|object");
b019632002-10-15Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`>>", 2, "int(0..)|object");
07c0731996-06-21Fredrik Hübinette (Hubbe)  }
ba18302002-04-20Johan Sundström 
b019632002-10-15Henrik Grubbström (Grubba)  if (sp[-1].u.integer < 0) {
66c9392002-10-15Henrik Grubbström (Grubba)  int args = 2;
b019632002-10-15Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`>>", 2, "int(0..)|object");
ba18302002-04-20Johan Sundström  }
b019632002-10-15Henrik Grubbström (Grubba) 
84ca422013-06-17Martin Nilsson  if( INT_TYPE_RSH_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer) )
b019632002-10-15Henrik Grubbström (Grubba)  {
ba18302002-04-20Johan Sundström  sp--; if (sp[-1].u.integer < 0) {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, -1);
ba18302002-04-20Johan Sundström  } else {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, 0);
ba18302002-04-20Johan Sundström  } return; } sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer >> sp->u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
b90e552001-02-08Henrik Grubbström (Grubba) /*! @decl int `>>(int arg1, int arg2) *! @decl mixed `>>(object arg1, int|object arg2) *! @decl mixed `>>(int arg1, object arg2)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg1] is an object that implements @[lfun::`>>()], that *! function will be called with @[arg2] as the single argument.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg2] is an object that implements @[lfun::``>>()], that *! function will be called with @[arg1] as the single argument.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
9a147d2002-08-02Johan Sundström  *! Otherwise @[arg1] will be shifted @[arg2] bits right.
b90e552001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[`<<()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_rsh(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
54db6c1999-03-27Henrik Grubbström (Grubba)  if(args != 2) { /* FIXME: Not appropriate if too many args. */ SIMPLE_TOO_FEW_ARGS_ERROR("`>>", 2); }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  o_rsh(); } static int generate_rsh(node *n) { if(count_args(CDR(n))==2)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_RSH);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
bce86c1996-02-25Fredrik Hübinette (Hubbe)  #define TWO_TYPES(X,Y) (((X)<<8)|(Y))
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_multiply(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 2;
017b572011-10-28Henrik Grubbström (Grubba)  switch(TWO_TYPES(TYPEOF(sp[-2]), TYPEOF(sp[-1])))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
1b61661998-02-19Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_ARRAY, T_INT): { struct array *ret; struct svalue *pos; INT32 e; if(sp[-1].u.integer < 0)
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`*", 2, "int(0..)");
1b61661998-02-19Fredrik Hübinette (Hubbe)  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; }
3a3bc32000-09-26Henrik Wallin  case TWO_TYPES(T_ARRAY, T_FLOAT): {
7c46f22000-10-15Henrik Grubbström (Grubba)  struct array *src;
3a3bc32000-09-26Henrik Wallin  struct array *ret; struct svalue *pos;
7c46f22000-10-15Henrik Grubbström (Grubba)  ptrdiff_t asize, delta;
3a3bc32000-09-26Henrik Wallin  if(sp[-1].u.float_number < 0) SIMPLE_BAD_ARG_ERROR("`*", 2, "float(0..)");
7c46f22000-10-15Henrik Grubbström (Grubba)  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;
fa95e62000-10-15Henrik Grubbström (Grubba)  if (asize > delta) {
3ee2ea2000-10-15Henrik Grubbström (Grubba)  ret->type_field = src->type_field;
3a3bc32000-09-26Henrik Wallin  assign_svalues_no_free(pos,
7c46f22000-10-15Henrik Grubbström (Grubba)  src->item, delta, src->type_field); pos += delta; asize -= delta;
fa95e62000-10-15Henrik Grubbström (Grubba)  while (asize > delta) {
7c46f22000-10-15Henrik Grubbström (Grubba)  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) {
2523ce2003-04-28Martin Stjernholm  ret->type_field = assign_svalues_no_free(pos, src->item, asize, src->type_field);
7c46f22000-10-15Henrik Grubbström (Grubba)  }
3a3bc32000-09-26Henrik Wallin  pop_n_elems(2); push_array(ret); return; } case TWO_TYPES(T_STRING, T_FLOAT): {
7c46f22000-10-15Henrik Grubbström (Grubba)  struct pike_string *src;
3a3bc32000-09-26Henrik Wallin  struct pike_string *ret; char *pos;
7c46f22000-10-15Henrik Grubbström (Grubba)  ptrdiff_t len, delta;
3a3bc32000-09-26Henrik Wallin  if(sp[-1].u.float_number < 0) SIMPLE_BAD_ARG_ERROR("`*", 2, "float(0..)");
7c46f22000-10-15Henrik Grubbström (Grubba)  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;
fa95e62000-10-15Henrik Grubbström (Grubba)  if (len > delta) {
7c46f22000-10-15Henrik Grubbström (Grubba)  MEMCPY(pos, src->str, delta); pos += delta; len -= delta;
fa95e62000-10-15Henrik Grubbström (Grubba)  while (len > delta) {
7c46f22000-10-15Henrik Grubbström (Grubba)  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);
fc3a642000-09-26Henrik Wallin  }
3a3bc32000-09-26Henrik Wallin  pop_n_elems(2); push_string(low_end_shared_string(ret)); return; }
1b61661998-02-19Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_STRING, T_INT): { struct pike_string *ret; char *pos;
e4b2252000-08-09Henrik Grubbström (Grubba)  INT_TYPE e; ptrdiff_t len;
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(sp[-1].u.integer < 0)
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("`*", 2, "int(0..)");
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  ret=begin_wide_shared_string(sp[-2].u.string->len * sp[-1].u.integer, sp[-2].u.string->size_shift);
1b61661998-02-19Fredrik Hübinette (Hubbe)  pos=ret->str;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  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);
1b61661998-02-19Fredrik Hübinette (Hubbe)  pop_n_elems(2);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  push_string(low_end_shared_string(ret));
1b61661998-02-19Fredrik Hübinette (Hubbe)  return; }
bce86c1996-02-25Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_ARRAY,T_STRING):
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *ret;
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  ret=implode(sp[-2].u.array,sp[-1].u.string); free_string(sp[-1].u.string); free_array(sp[-2].u.array);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_STRING, 0, string, ret);
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--; return; }
f5466b1997-02-18Fredrik Hübinette (Hubbe)  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);
1b61661998-02-19Fredrik Hübinette (Hubbe)  return;
f5466b1997-02-18Fredrik Hübinette (Hubbe)  }
bce86c1996-02-25Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_FLOAT,T_FLOAT):
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--; sp[-1].u.float_number *= sp[0].u.float_number; return;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  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=
6e34c62003-11-13Martin Stjernholm  (FLOAT_TYPE) sp[-1].u.integer * sp[0].u.float_number;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL_TYPE(sp[-1], T_FLOAT);
bce86c1996-02-25Fredrik Hübinette (Hubbe)  return; case TWO_TYPES(T_INT,T_INT):
42d0cd2012-12-31Arne Goedeke  { INT_TYPE res;
60586c2014-01-11Arne Goedeke  if (DO_INT_TYPE_MUL_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer, &res))
fda0de1999-10-08Fredrik Noring  {
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  convert_stack_top_to_bignum(); goto do_lfun_multiply;
fda0de1999-10-08Fredrik Noring  }
84ca422013-06-17Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--;
42d0cd2012-12-31Arne Goedeke  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, res);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
42d0cd2012-12-31Arne Goedeke  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  do_lfun_multiply:
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(call_lfun(LFUN_MULTIPLY, LFUN_RMULTIPLY))
07c0731996-06-21Fredrik Hübinette (Hubbe)  return;
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`*", "Bad arguments.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
b90e552001-02-08Henrik Grubbström (Grubba) /*! @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)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns
dfceb02003-11-10Martin Stjernholm  *! If there's a single argument, that argument will be returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! 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
9fcd242002-05-31Martin Nilsson  *! @expr{`*(`*(@[arg1], @[arg2]), @@@[extras])@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! 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:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type array
b00d6d2001-07-27Martin Nilsson  *! @mixed arg2
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type int|float
28984e2001-05-09Henrik Grubbström (Grubba)  *! The result will be @[arg1] concatenated @[arg2] times.
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type string|array
28984e2001-05-09Henrik Grubbström (Grubba)  *! The result will be the elements of @[arg1] concatenated with *! @[arg2] interspersed. *! @endmixed *! @type string *! The result will be @[arg1] concatenated @[arg2] times.
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type int|float
9fcd242002-05-31Martin Nilsson  *! The result will be @expr{@[arg1] * @[arg2]@}, and will be a
28984e2001-05-09Henrik Grubbström (Grubba)  *! float if either @[arg1] or @[arg2] is a float. *! @endmixed
b90e552001-02-08Henrik Grubbström (Grubba)  *! *! @note *! In Pike 7.0 and earlier the multiplication order was unspecified. *! *! @seealso
fe9d712002-11-26Henrik Grubbström (Grubba)  *! @[`+()], @[`-()], @[`/()], @[lfun::`*()], @[lfun::``*()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_multiply(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
54db6c1999-03-27Henrik Grubbström (Grubba)  case 0: SIMPLE_TOO_FEW_ARGS_ERROR("`*", 1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: return; case 2: o_multiply(); return;
07c0731996-06-21Fredrik Hübinette (Hubbe)  default:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) == T_OBJECT)
07c0731996-06-21Fredrik Hübinette (Hubbe)  { CALL_OPERATOR(LFUN_MULTIPLY, args); } else {
0c60972000-09-22Henrik Grubbström (Grubba)  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(); }
07c0731996-06-21Fredrik Hübinette (Hubbe)  }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  } } static int generate_multiply(node *n) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  switch(count_args(CDR(n))) { case 1: do_docode(CDR(n),0); return 1; case 2: do_docode(CDR(n),0);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_MULTIPLY);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; default: return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_divide(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) != TYPEOF(sp[-1]) && !float_promote())
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  { if(call_lfun(LFUN_DIVIDE, LFUN_RDIVIDE)) return;
1b61661998-02-19Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TWO_TYPES(TYPEOF(sp[-2]), TYPEOF(sp[-1])))
1b61661998-02-19Fredrik Hübinette (Hubbe)  { case TWO_TYPES(T_STRING,T_INT): { struct array *a;
e4b2252000-08-09Henrik Grubbström (Grubba)  INT_TYPE len; ptrdiff_t size,e,pos=0;
1b61661998-02-19Fredrik Hübinette (Hubbe)  len=sp[-1].u.integer; if(!len)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) { len=-len;
d429a71998-02-24Fredrik Hübinette (Hubbe)  size=sp[-2].u.string->len / len; pos+=sp[-2].u.string->len % len; }else{ size=sp[-2].u.string->len / len;
1b61661998-02-19Fredrik Hübinette (Hubbe)  } a=allocate_array(size); for(e=0;e<size;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_STRING, 0, string, string_slice(sp[-2].u.string, pos,len));
1b61661998-02-19Fredrik Hübinette (Hubbe)  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;
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t size, pos, last, e;
6e34c62003-11-13Martin Stjernholm  FLOAT_ARG_TYPE len;
1b61661998-02-19Fredrik Hübinette (Hubbe)  len=sp[-1].u.float_number; if(len==0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) { len=-len;
e4b2252000-08-09Henrik Grubbström (Grubba)  size=(ptrdiff_t)ceil( ((double)sp[-2].u.string->len) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
d429a71998-02-24Fredrik Hübinette (Hubbe)  for(last=sp[-2].u.string->len,e=0;e<size-1;e++)
1b61661998-02-19Fredrik Hübinette (Hubbe)  {
61014a2000-09-26Henrik Wallin  pos=sp[-2].u.string->len - (ptrdiff_t)((e+1)*len+0.5);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[size-1-e], T_STRING, 0, string, string_slice(sp[-2].u.string, pos, last-pos));
1b61661998-02-19Fredrik Hübinette (Hubbe)  last=pos; } pos=0;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[0], T_STRING, 0, string, string_slice(sp[-2].u.string, pos, last-pos));
1b61661998-02-19Fredrik Hübinette (Hubbe)  }else{
080b1a2000-08-10Henrik Grubbström (Grubba)  size=(ptrdiff_t)ceil( ((double)sp[-2].u.string->len) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
d429a71998-02-24Fredrik Hübinette (Hubbe)  for(last=0,e=0;e<size-1;e++)
1b61661998-02-19Fredrik Hübinette (Hubbe)  {
61014a2000-09-26Henrik Wallin  pos = DO_NOT_WARN((ptrdiff_t)((e+1)*len+0.5));
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_STRING, 0, string, string_slice(sp[-2].u.string, last, pos-last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  last=pos; }
d429a71998-02-24Fredrik Hübinette (Hubbe)  pos=sp[-2].u.string->len;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_STRING, 0, string, string_slice(sp[-2].u.string, last, pos-last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  } a->type_field=BIT_STRING; pop_n_elems(2); push_array(a);
d429a71998-02-24Fredrik Hübinette (Hubbe)  return;
1b61661998-02-19Fredrik Hübinette (Hubbe)  } case TWO_TYPES(T_ARRAY, T_INT): { struct array *a;
6e34c62003-11-13Martin Stjernholm  ptrdiff_t size,e,pos;
1b61661998-02-19Fredrik Hübinette (Hubbe) 
6e34c62003-11-13Martin Stjernholm  INT_TYPE len=sp[-1].u.integer;
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(!len)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
a5a6492011-03-03Martin Stjernholm  if (!Pike_sp[-2].u.array->size) { pop_n_elems (2); ref_push_array (&empty_array); return; }
6e27f61998-07-31Fredrik Hübinette (Hubbe) 
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) {
6f49401998-07-31Henrik Grubbström (Grubba)  len = -len; pos = sp[-2].u.array->size % len;
d429a71998-02-24Fredrik Hübinette (Hubbe)  }else{
6f49401998-07-31Henrik Grubbström (Grubba)  pos = 0;
1b61661998-02-19Fredrik Hübinette (Hubbe)  }
6f49401998-07-31Henrik Grubbström (Grubba)  size = sp[-2].u.array->size / len;
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size); for(e=0;e<size;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_ARRAY, 0, array, friendly_slice_array(sp[-2].u.array, pos, pos+len));
1b61661998-02-19Fredrik Hübinette (Hubbe)  pos+=len; } a->type_field=BIT_ARRAY; pop_n_elems(2); push_array(a); return; } case TWO_TYPES(T_ARRAY,T_FLOAT): { struct array *a;
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t last,pos,e,size;
6e34c62003-11-13Martin Stjernholm  FLOAT_ARG_TYPE len;
1b61661998-02-19Fredrik Hübinette (Hubbe)  len=sp[-1].u.float_number; if(len==0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
1b61661998-02-19Fredrik Hübinette (Hubbe) 
a5a6492011-03-03Martin Stjernholm  if (!Pike_sp[-2].u.array->size) { pop_n_elems (2); ref_push_array (&empty_array); return; }
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) { len=-len;
e4b2252000-08-09Henrik Grubbström (Grubba)  size = (ptrdiff_t)ceil( ((double)sp[-2].u.array->size) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
d429a71998-02-24Fredrik Hübinette (Hubbe)  for(last=sp[-2].u.array->size,e=0;e<size-1;e++)
1b61661998-02-19Fredrik Hübinette (Hubbe)  {
61014a2000-09-26Henrik Wallin  pos=sp[-2].u.array->size - (ptrdiff_t)((e+1)*len+0.5);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[size-1-e], T_ARRAY, 0, array, friendly_slice_array(sp[-2].u.array, pos, last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  last=pos; }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[0], T_ARRAY, 0, array, slice_array(sp[-2].u.array, 0, last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  }else{
080b1a2000-08-10Henrik Grubbström (Grubba)  size = (ptrdiff_t)ceil( ((double)sp[-2].u.array->size) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
d429a71998-02-24Fredrik Hübinette (Hubbe)  for(last=0,e=0;e<size-1;e++)
1b61661998-02-19Fredrik Hübinette (Hubbe)  {
61014a2000-09-26Henrik Wallin  pos = (ptrdiff_t)((e+1)*len+0.5);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_ARRAY, 0, array, friendly_slice_array(sp[-2].u.array, last, pos));
1b61661998-02-19Fredrik Hübinette (Hubbe)  last=pos; }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_ARRAY, 0, array, slice_array(sp[-2].u.array, last, sp[-2].u.array->size));
1b61661998-02-19Fredrik Hübinette (Hubbe)  } a->type_field=BIT_ARRAY; pop_n_elems(2); push_array(a);
d429a71998-02-24Fredrik Hübinette (Hubbe)  return;
1b61661998-02-19Fredrik Hübinette (Hubbe)  } }
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`/", "Division on different types.\n", sp, 2);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
08b9801999-10-30Fredrik Noring  do_lfun_division:
07c0731996-06-21Fredrik Hübinette (Hubbe)  CALL_OPERATOR(LFUN_DIVIDE,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_STRING: { struct array *ret;
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  ret=explode(sp[-2].u.string,sp[-1].u.string); free_string(sp[-2].u.string);
5267b71995-08-09Fredrik Hübinette (Hubbe)  free_string(sp[-1].u.string);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_ARRAY, 0, array, ret);
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  sp--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
f5466b1997-02-18Fredrik Hübinette (Hubbe)  case T_ARRAY: { struct array *ret=explode_array(sp[-2].u.array, sp[-1].u.array); pop_n_elems(2); push_array(ret); return; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT: if(sp[-1].u.float_number == 0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--; sp[-1].u.float_number /= sp[0].u.float_number; return; case T_INT:
806a2c1997-04-28Fredrik Hübinette (Hubbe)  {
e4b2252000-08-09Henrik Grubbström (Grubba)  INT_TYPE tmp;
08b9801999-10-30Fredrik Noring 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if (sp[-1].u.integer == 0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
806a2c1997-04-28Fredrik Hübinette (Hubbe) 
08b9801999-10-30Fredrik Noring  if(INT_TYPE_DIV_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer)) { stack_swap(); convert_stack_top_to_bignum(); stack_swap(); goto do_lfun_division; } else tmp = sp[-2].u.integer/sp[-1].u.integer; sp--;
c93f0e1997-12-03Fredrik Hübinette (Hubbe) 
08b9801999-10-30Fredrik Noring  /* What is this trying to solve? /Noring */
6e34c62003-11-13Martin Stjernholm  /* It fixes rounding towards negative infinity. /mast */
c93f0e1997-12-03Fredrik Hübinette (Hubbe)  if((sp[-1].u.integer<0) != (sp[0].u.integer<0)) if(tmp*sp[0].u.integer!=sp[-1].u.integer)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  tmp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, tmp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
806a2c1997-04-28Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`/", "Bad argument 1.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @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)
441e212002-12-30Henrik Grubbström (Grubba)  *! @decl array(string) `/(string arg1, string arg2)
8d1b862001-02-08Henrik Grubbström (Grubba)  *! @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)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns *! If there are more than two arguments, the result will be
9fcd242002-05-31Martin Nilsson  *! @expr{`/(`/(@[arg1], @[arg2]), @@@[extras])@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! 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:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type string
b00d6d2001-07-27Martin Nilsson  *! @mixed arg2
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type int|float
28984e2001-05-09Henrik Grubbström (Grubba)  *! 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
b00d6d2001-07-27Martin Nilsson  *! @mixed arg2
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type int|float
28984e2001-05-09Henrik Grubbström (Grubba)  *! 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
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type float|int
9fcd242002-05-31Martin Nilsson  *! The result will be @expr{@[arg1] / @[arg2]@}. If both arguments
28984e2001-05-09Henrik Grubbström (Grubba)  *! are int, the result will be truncated to an int. Otherwise the *! result will be a float. *! @endmixed
b8d9a02003-01-15Johan Sundström  *! @note
7f95db2003-01-15Martin Nilsson  *! 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
b8d9a02003-01-15Johan Sundström  *! 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 *! @[`%]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_divide(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) {
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  switch(args) { case 0:
54db6c1999-03-27Henrik Grubbström (Grubba)  case 1: SIMPLE_TOO_FEW_ARGS_ERROR("`/", 2);
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  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); } }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) } static int generate_divide(node *n) { if(count_args(CDR(n))==2) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
5e44422001-02-25Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_DIVIDE);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_mod(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) != TYPEOF(sp[-1]) && !float_promote())
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
4c86e32013-01-11Arne Goedeke do_lfun_modulo:
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(call_lfun(LFUN_MOD, LFUN_RMOD)) return;
017b572011-10-28Henrik Grubbström (Grubba)  switch(TWO_TYPES(TYPEOF(sp[-2]), TYPEOF(sp[-1])))
1b61661998-02-19Fredrik Hübinette (Hubbe)  { case TWO_TYPES(T_STRING,T_INT): { struct pike_string *s=sp[-2].u.string;
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t tmp,base;
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(!sp[-1].u.integer)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
1b61661998-02-19Fredrik Hübinette (Hubbe) 
6e34c62003-11-13Martin Stjernholm  if(sp[-1].u.integer<0)
d429a71998-02-24Fredrik Hübinette (Hubbe)  {
6e34c62003-11-13Martin Stjernholm  tmp=s->len % -sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=0; }else{
6e34c62003-11-13Martin Stjernholm  tmp=s->len % sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=s->len - tmp; }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  s=string_slice(s, base, tmp);
1b61661998-02-19Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_string(s); return; } case TWO_TYPES(T_ARRAY,T_INT): { struct array *a=sp[-2].u.array;
6e34c62003-11-13Martin Stjernholm  ptrdiff_t tmp,base;
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(!sp[-1].u.integer)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
1b61661998-02-19Fredrik Hübinette (Hubbe) 
6e34c62003-11-13Martin Stjernholm  if(sp[-1].u.integer<0)
d429a71998-02-24Fredrik Hübinette (Hubbe)  {
6e34c62003-11-13Martin Stjernholm  tmp=a->size % -sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=0; }else{
6e34c62003-11-13Martin Stjernholm  tmp=a->size % sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=a->size - tmp; }
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=slice_array(a,base,base+tmp); pop_n_elems(2); push_array(a); return; } }
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`%", "Modulo on different types.\n", sp, 2);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_MOD,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT: { FLOAT_TYPE foo; if(sp[-1].u.float_number == 0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--;
a5cd6a2001-09-24Henrik Grubbström (Grubba)  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)));
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp[-1].u.float_number=foo; return; } case T_INT:
4c86e32013-01-11Arne Goedeke  { int of = 0; INT_TYPE a = sp[-2].u.integer, b = sp[-1].u.integer; INT_TYPE res; if (b == 0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
4c86e32013-01-11Arne Goedeke  if(a>=0)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  {
4c86e32013-01-11Arne Goedeke  if(b>=0)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  {
4c86e32013-01-11Arne Goedeke  res = a % b;
806a2c1997-04-28Fredrik Hübinette (Hubbe)  }else{
4c86e32013-01-11Arne Goedeke  /* res = ((a+~b)%-b)-~b */
60586c2014-01-11Arne Goedeke  of = DO_INT_TYPE_ADD_OVERFLOW(a, ~b, &res) || DO_INT_TYPE_MOD_OVERFLOW(res, b, &res) || DO_INT_TYPE_SUB_OVERFLOW(res, ~b, &res);
806a2c1997-04-28Fredrik Hübinette (Hubbe)  } }else{
4c86e32013-01-11Arne Goedeke  if(b>=0)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  {
4c86e32013-01-11Arne Goedeke  /* res = b+~((~a) % b) */
60586c2014-01-11Arne Goedeke  of = DO_INT_TYPE_MOD_OVERFLOW(~a, b, &res) || DO_INT_TYPE_ADD_OVERFLOW(b, ~res, &res);
806a2c1997-04-28Fredrik Hübinette (Hubbe)  }else{
4c86e32013-01-11Arne Goedeke  /* a % b and a % -b are equivalent, if overflow does not * happen * res = -(-a % -b) = a % b; */
60586c2014-01-11Arne Goedeke  of = DO_INT_TYPE_MOD_OVERFLOW(a, b, &res);
806a2c1997-04-28Fredrik Hübinette (Hubbe)  } }
4c86e32013-01-11Arne Goedeke  if (of) { stack_swap(); convert_stack_top_to_bignum(); stack_swap(); goto do_lfun_modulo; } sp--; SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, res);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
4c86e32013-01-11Arne Goedeke  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`%", "Bad argument 1.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @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)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @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:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type string|array
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg2] is positive, the result will be the last
9fcd242002-05-31Martin Nilsson  *! @expr{`%(@[sizeof](@[arg1]), @[arg2])@} elements of @[arg1].
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg2] is negative, the result will be the first
9fcd242002-05-31Martin Nilsson  *! @expr{`%(@[sizeof](@[arg1]), -@[arg2])@} elements of @[arg1].
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type int|float
28984e2001-05-09Henrik Grubbström (Grubba)  *! The result will be
9fcd242002-05-31Martin Nilsson  *! @expr{@[arg1] - @[arg2]*@[floor](@[arg1]/@[arg2])@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! The result will be a float if either @[arg1] or @[arg2] is *! a float, and an int otherwise. *! @endmixed
b8d9a02003-01-15Johan Sundström  *! *! 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 *! @[`/]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_mod(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
54db6c1999-03-27Henrik Grubbström (Grubba)  if(args != 2) { /* FIXME: Not appropriate when too many args. */ SIMPLE_TOO_FEW_ARGS_ERROR("`%", 2); }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  o_mod(); } static int generate_mod(node *n) { if(count_args(CDR(n))==2)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
5e44422001-02-25Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_MOD);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_not(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_INT:
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, !sp[-1].u.integer);
07c0731996-06-21Fredrik Hübinette (Hubbe)  break; case T_FUNCTION: case T_OBJECT:
9f516a2001-12-16Martin Stjernholm  if(UNSAFE_IS_ZERO(sp-1))
07c0731996-06-21Fredrik Hübinette (Hubbe)  { pop_stack(); push_int(1); }else{ pop_stack(); push_int(0); } break; default: free_svalue(sp-1);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @decl int(0..1) `!(object|function arg) *! @decl int(1..1) `!(int(0..0) arg) *! @decl int(0..0) `!(mixed arg)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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.
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns *! If @[arg] is an object that implements @[lfun::`!()], that function *! will be called.
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! If @[arg] is @expr{0@} (zero), a destructed object, or a function in a *! destructed object, @expr{1@} will be returned.
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! Otherwise @expr{0@} (zero) will be returned.
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! @note *! No float is considered false, not even @expr{0.0@}. *!
8d1b862001-02-08Henrik Grubbström (Grubba)  *! @seealso *! @[`==()], @[`!=()], @[lfun::`!()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_not(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) {
54db6c1999-03-27Henrik Grubbström (Grubba)  if(args != 1) { /* FIXME: Not appropriate with too many args. */ SIMPLE_TOO_FEW_ARGS_ERROR("`!", 1); }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  o_not(); } static int generate_not(node *n)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  if(count_args(CDR(n))==1) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_NOT);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe) }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_compl(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_COMPL,1); break;
8a630c1996-04-13Fredrik Hübinette (Hubbe)  case T_INT:
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, ~sp[-1].u.integer);
8a630c1996-04-13Fredrik Hübinette (Hubbe)  break; case T_FLOAT:
e956bb2008-07-11Martin Stjernholm  sp[-1].u.float_number = (FLOAT_TYPE) -1.0 - sp[-1].u.float_number;
8a630c1996-04-13Fredrik Hübinette (Hubbe)  break;
0e801c1999-12-13Henrik Grubbström (Grubba)  case T_TYPE: type_stack_mark();
1a94cc2001-02-26Henrik Grubbström (Grubba)  if (sp[-1].u.type->type == T_NOT) { push_finished_type(sp[-1].u.type->car);
dc7d491999-12-15Henrik Grubbström (Grubba)  } else {
1a94cc2001-02-26Henrik Grubbström (Grubba)  push_finished_type(sp[-1].u.type);
dc7d491999-12-15Henrik Grubbström (Grubba)  push_type(T_NOT); }
0e801c1999-12-13Henrik Grubbström (Grubba)  pop_stack();
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(pop_unfinished_type());
0e801c1999-12-13Henrik Grubbström (Grubba)  break;
dc7d491999-12-15Henrik Grubbström (Grubba)  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();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  push_type(T_NOT); pop_stack();
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  } break;
fc0bb51997-02-13Niels Möller  case T_STRING: { struct pike_string *s;
080b1a2000-08-10Henrik Grubbström (Grubba)  ptrdiff_t len, i;
fc0bb51997-02-13Niels Möller 
54db6c1999-03-27Henrik Grubbström (Grubba)  if(sp[-1].u.string->size_shift) { bad_arg_error("`~", sp-1, 1, 1, "string(0)", sp-1, "Expected 8-bit string.\n"); }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) 
fc0bb51997-02-13Niels Möller  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; }
8a630c1996-04-13Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`~", "Bad argument.\n", sp, 1);
8a630c1996-04-13Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `~(object arg) *! @decl int `~(int arg) *! @decl float `~(float arg) *! @decl type `~(type|program arg) *! @decl string `~(string arg)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns *! The result will be as follows:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type object *! If @[arg] implements @[lfun::`~()], that function will be called. *! @type int *! The bitwise inverse of @[arg] will be returned. *! @type float
9fcd242002-05-31Martin Nilsson  *! The result will be @expr{-1.0 - @[arg]@}.
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type type|program
28984e2001-05-09Henrik Grubbström (Grubba)  *! The type inverse of @[arg] will be returned. *! @type string
c7b7dd2001-10-28Martin Nilsson  *! If @[arg] only contains characters in the range 0 - 255 (8-bit),
28984e2001-05-09Henrik Grubbström (Grubba)  *! a string containing the corresponding 8-bit inverses will be *! returned. *! @endmixed
8d1b862001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[`!()], @[lfun::`~()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_compl(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) {
54db6c1999-03-27Henrik Grubbström (Grubba)  if(args != 1) { /* FIXME: Not appropriate with too many args. */ SIMPLE_TOO_FEW_ARGS_ERROR("`~", 1); }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  o_compl(); } static int generate_compl(node *n) { if(count_args(CDR(n))==1) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_COMPL);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_negate(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
ff0d461999-10-15Fredrik Noring  do_lfun_negate:
07c0731996-06-21Fredrik Hübinette (Hubbe)  CALL_OPERATOR(LFUN_SUBTRACT,1); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT: sp[-1].u.float_number=-sp[-1].u.float_number; return; case T_INT:
ff0d461999-10-15Fredrik Noring  if(INT_TYPE_NEG_OVERFLOW(sp[-1].u.integer)) { convert_stack_top_to_bignum(); goto do_lfun_negate; }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, -sp[-1].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`-", "Bad argument to unary minus.\n", sp, 1);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
408a1e2004-10-30Martin Stjernholm static void string_or_array_range (int bound_types, struct svalue *ind, INT_TYPE low, INT_TYPE high) /* ind is modified to point to the range. low and high are INT_TYPE to * avoid truncation problems when they come from int svalues. */
5267b71995-08-09Fredrik Hübinette (Hubbe) {
408a1e2004-10-30Martin Stjernholm  INT32 from, to, len; /* to and len are not inclusive. */
8a586b1997-01-27Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_STRING)
408a1e2004-10-30Martin Stjernholm  len = ind->u.string->len; else { #ifdef PIKE_DEBUG
017b572011-10-28Henrik Grubbström (Grubba)  if (!ind || TYPEOF(*ind) != T_ARRAY) Pike_fatal ("Invalid ind svalue.\n");
408a1e2004-10-30Martin Stjernholm #endif len = ind->u.array->size;
8a586b1997-01-27Fredrik Hübinette (Hubbe)  }
408a1e2004-10-30Martin Stjernholm  if (bound_types & RANGE_LOW_OPEN) from = 0; else {
07cc182008-09-04Marcus Comstedt  if (bound_types & RANGE_LOW_FROM_END) { if (low >= len) from = 0; else if (low < 0) from = len; else from = len - 1 - low; } else { if (low < 0) from = 0; else if (low > len) from = len; else from = low; }
408a1e2004-10-30Martin Stjernholm  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
408a1e2004-10-30Martin Stjernholm  if (bound_types & RANGE_HIGH_OPEN) to = len; else {
07cc182008-09-04Marcus Comstedt  if (bound_types & RANGE_HIGH_FROM_END) { if (high > len - from) to = from; else if (high <= 0) to = len; else to = len - high; } else { if (high < from) to = from; else if (high >= len) to = len; else to = high + 1; }
408a1e2004-10-30Martin Stjernholm  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_STRING) {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s;
408a1e2004-10-30Martin Stjernholm  if (from == 0 && to == len) return;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
408a1e2004-10-30Martin Stjernholm  s=string_slice(ind->u.string, from, to-from); free_string(ind->u.string); ind->u.string=s; } else { struct array *a; a = slice_array(ind->u.array, from, to); free_array(ind->u.array); ind->u.array=a; } } static int call_old_range_lfun (int bound_types, struct object *o, struct svalue *low, struct svalue *high) /* Returns nonzero on errors to let the caller format the appropriate * messages to throw. o is assumed to be undestructed on entry. One * ref each is consumed to low and high when they're in use. */ { struct svalue end_pos; ONERROR uwp; int f; if ((f = FIND_LFUN (o->prog, LFUN_INDEX)) == -1) return 1; /* FIXME: Check if the `[] lfun accepts at least two arguments. */ /* o[a..b] => o->`[] (a, b) * o[a..<b] => o->`[] (a, o->_sizeof()-1-b) * o[a..] => o->`[] (a, Pike.NATIVE_MAX) * o[<a..b] => o->`[] (o->_sizeof()-1-a, b) * o[<a..<b] => o->`[] (o->_sizeof()-1-a, o->_sizeof()-1-b) * o[<a..] => o->`[] (o->_sizeof()-1-a, Pike.NATIVE_MAX) * o[..b] => o->`[] (0, b) * o[..<b] => o->`[] (0, o->_sizeof()-1-b) * o[..] => o->`[] (0, Pike.NATIVE_MAX) */ if (bound_types & (RANGE_LOW_FROM_END|RANGE_HIGH_FROM_END)) { int f2 = FIND_LFUN (o->prog, LFUN__SIZEOF); if (f2 == -1) return 2; apply_low (o, f2, 0); push_int (1); o_subtract(); move_svalue (&end_pos, --sp); SET_ONERROR (uwp, do_free_svalue, &end_pos); } switch (bound_types & (RANGE_LOW_FROM_BEG|RANGE_LOW_FROM_END|RANGE_LOW_OPEN)) { case RANGE_LOW_FROM_BEG: move_svalue (sp++, low);
0c21e52008-03-29Martin Stjernholm  mark_free_svalue (low);
408a1e2004-10-30Martin Stjernholm  break; case RANGE_LOW_OPEN: push_int (0); break; default: push_svalue (&end_pos); move_svalue (sp++, low);
0c21e52008-03-29Martin Stjernholm  mark_free_svalue (low);
408a1e2004-10-30Martin Stjernholm  o_subtract(); break; } switch (bound_types & (RANGE_HIGH_FROM_BEG|RANGE_HIGH_FROM_END|RANGE_HIGH_OPEN)) { case RANGE_HIGH_FROM_BEG: move_svalue (sp++, high);
0c21e52008-03-29Martin Stjernholm  mark_free_svalue (high);
408a1e2004-10-30Martin Stjernholm  break; case RANGE_HIGH_OPEN: push_int (MAX_INT_TYPE); break; default: push_svalue (&end_pos); move_svalue (sp++, high);
0c21e52008-03-29Martin Stjernholm  mark_free_svalue (high);
408a1e2004-10-30Martin Stjernholm  o_subtract(); break; } if (bound_types & (RANGE_LOW_FROM_END|RANGE_HIGH_FROM_END)) { UNSET_ONERROR (uwp); free_svalue (&end_pos); /* Anything might have happened during the calls to * LFUN__SIZEOF and o_subtract above. */ if (!o->prog) return 3; } apply_low (o, f, 2); return 0; } static const char *range_func_name (int bound_types) { /* Since the number of arguments on the stack depend on bound_types * we have to make some effort to make it show in the backtrace. */ switch (bound_types) { case RANGE_LOW_FROM_BEG|RANGE_HIGH_FROM_BEG: return "arg1[arg2..arg3]"; case RANGE_LOW_FROM_BEG|RANGE_HIGH_FROM_END: return "arg1[arg2..<arg3]"; case RANGE_LOW_FROM_BEG|RANGE_HIGH_OPEN: return "arg1[arg2..]"; case RANGE_LOW_FROM_END|RANGE_HIGH_FROM_BEG: return "arg1[<arg2..arg3]"; case RANGE_LOW_FROM_END|RANGE_HIGH_FROM_END: return "arg1[<arg2..<arg3]"; case RANGE_LOW_FROM_END|RANGE_HIGH_OPEN: return "arg1[<arg2..]"; case RANGE_LOW_OPEN|RANGE_HIGH_FROM_BEG: return "arg1[..arg2]"; case RANGE_LOW_OPEN|RANGE_HIGH_FROM_END: return "arg1[..<arg2]"; case RANGE_LOW_OPEN|RANGE_HIGH_OPEN: return "arg1[..]";
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
408a1e2004-10-30Martin Stjernholm  default: Pike_fatal ("Unexpected bound_types.\n");
62260a1996-11-26Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
ec51ce2006-04-25David Hedbor  return "Unexpected bound_types"; /* Make compiler quiet */
408a1e2004-10-30Martin Stjernholm }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
408a1e2004-10-30Martin Stjernholm PMOD_EXPORT void o_range2 (int bound_types) /* This takes between one and three args depending on whether * RANGE_LOW_OPEN and/or RANGE_HIGH_OPEN is set in bound_types. */ { struct svalue *ind, *low, *high; high = bound_types & RANGE_HIGH_OPEN ? sp : sp - 1; low = bound_types & RANGE_LOW_OPEN ? high : high - 1; ind = low - 1;
017b572011-10-28Henrik Grubbström (Grubba)  switch (TYPEOF(*ind)) {
408a1e2004-10-30Martin Stjernholm  case T_OBJECT: { struct object *o = ind->u.object; int f; if (!o->prog) bad_arg_error (range_func_name (bound_types), ind, sp - ind, 1, "object", ind, "Cannot call `[..] in destructed object.\n");
017b572011-10-28Henrik Grubbström (Grubba)  if ((f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(*ind)].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN_RANGE)) != -1) {
408a1e2004-10-30Martin Stjernholm  struct svalue h; if (!(bound_types & RANGE_HIGH_OPEN)) { move_svalue (&h, high); sp = high; } if (bound_types & RANGE_LOW_FROM_BEG) push_int (INDEX_FROM_BEG); else if (bound_types & RANGE_LOW_OPEN) { push_int (0); push_int (OPEN_BOUND); } else push_int (INDEX_FROM_END); if (bound_types & RANGE_HIGH_FROM_BEG) { move_svalue (sp++, &h); push_int (INDEX_FROM_BEG); } else if (bound_types & RANGE_HIGH_OPEN) { push_int (0); push_int (OPEN_BOUND); } else { move_svalue (sp++, &h); push_int (INDEX_FROM_END); } apply_low (o, f, 4); stack_pop_keep_top(); }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
408a1e2004-10-30Martin Stjernholm  else switch (call_old_range_lfun (bound_types, o, low, high)) { case 1: bad_arg_error (range_func_name (bound_types), ind, sp - ind, 1, "object", ind, "Object got neither `[..] nor `[].\n"); case 2: bad_arg_error (range_func_name (bound_types), ind, sp - ind, 1, "object", ind, "Object got no `[..] and there is no _sizeof to " "translate the from-the-end index to use `[].\n"); case 3: bad_arg_error (range_func_name (bound_types), ind, 3, 1, "object", ind, "Cannot call `[..] in destructed object.\n"); default: free_svalue (ind); move_svalue (ind, sp - 1); /* low and high have lost their refs in call_old_range_lfun. */ sp = ind + 1; } break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
408a1e2004-10-30Martin Stjernholm  case T_STRING: case T_ARRAY: {
ec51ce2006-04-25David Hedbor  INT_TYPE l=0, h=0;
408a1e2004-10-30Martin Stjernholm  if (!(bound_types & RANGE_LOW_OPEN)) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*low) != T_INT)
408a1e2004-10-30Martin Stjernholm  bad_arg_error (range_func_name (bound_types), ind, sp - ind, 2, "int", low, "Bad lower bound. Expected int, got %s.\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type (TYPEOF(*low)));
408a1e2004-10-30Martin Stjernholm  l = low->u.integer; } if (!(bound_types & RANGE_HIGH_OPEN)) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*high) != T_INT)
408a1e2004-10-30Martin Stjernholm  bad_arg_error (range_func_name (bound_types), ind, sp - ind, high - ind + 1, "int", high, "Bad upper bound. Expected int, got %s.\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type (TYPEOF(*high)));
408a1e2004-10-30Martin Stjernholm  h = high->u.integer; } /* Can pop off the bounds without fuzz since they're simple integers. */ sp = ind + 1; string_or_array_range (bound_types, ind, l, h); break; } default: bad_arg_error (range_func_name (bound_types), ind, sp - ind, 1, "string|array|object", ind, "Cannot use [..] on a %s. Expected string, array or object.\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type (TYPEOF(*ind)));
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
408a1e2004-10-30Martin Stjernholm } /*! @decl mixed `[..](object arg, mixed start, int start_type, mixed end, int end_type) *! @decl string `[..](string arg, int start, int start_type, int end, int end_type) *! @decl array `[..](array arg, int start, int start_type, int end, int end_type) *! *! Extracts a subrange. *! *! This is the function form of expressions with the @expr{[..]@} *! operator. @[arg] is the thing from which the subrange is to be *! extracted. @[start] is the lower bound of the subrange and *! @[end] the upper bound. *! *! @[start_type] and @[end_type] specifies how the @[start] and *! @[end] indices, respectively, are to be interpreted. The types *! are either @[Pike.INDEX_FROM_BEG], @[Pike.INDEX_FROM_END] or *! @[Pike.OPEN_BOUND]. In the last case, the index value is *! insignificant. *! *! The relation between @expr{[..]@} expressions and this function *! is therefore as follows: *! *! @code *! a[i..j] <=> `[..] (a, i, Pike.INDEX_FROM_BEG, j, Pike.INDEX_FROM_BEG) *! a[i..<j] <=> `[..] (a, i, Pike.INDEX_FROM_BEG, j, Pike.INDEX_FROM_END) *! a[i..] <=> `[..] (a, i, Pike.INDEX_FROM_BEG, 0, Pike.OPEN_BOUND) *! a[<i..j] <=> `[..] (a, i, Pike.INDEX_FROM_END, j, Pike.INDEX_FROM_BEG) *! a[<i..<j] <=> `[..] (a, i, Pike.INDEX_FROM_END, j, Pike.INDEX_FROM_END) *! a[<i..] <=> `[..] (a, i, Pike.INDEX_FROM_END, 0, Pike.OPEN_BOUND) *! a[..j] <=> `[..] (a, 0, Pike.OPEN_BOUND, j, Pike.INDEX_FROM_BEG) *! a[..<j] <=> `[..] (a, 0, Pike.OPEN_BOUND, j, Pike.INDEX_FROM_END) *! a[..] <=> `[..] (a, 0, Pike.OPEN_BOUND, 0, Pike.OPEN_BOUND) *! @endcode *! *! The subrange is specified as follows by the two bounds: *! *! @ul *! @item *! If the lower bound refers to an index before the lowest *! allowable (typically zero) then it's taken as an open bound *! which starts at the first index (without any error). *! *! @item *! Correspondingly, if the upper bound refers to an index past *! the last allowable then it's taken as an open bound which *! ends at the last index (without any error). *! *! @item *! If the lower bound is less than or equal to the upper bound, *! then the subrange is the inclusive range between them, i.e. *! from and including the element at the lower bound and up to *! and including the element at the upper bound. *! *! @item *! If the lower bound is greater than the upper bound then the *! result is an empty subrange (without any error). *! @endul *! *! @returns *! The returned value depends on the type of @[arg]: *! *! @mixed arg *! @type string *! A string with the characters in the range is returned. *! *! @type array *! An array with the elements in the range is returned. *! *! @type object *! If the object implements @[lfun::`[..]], that function is *! called with the four remaining arguments. *! *! As a compatibility measure, if the object does not implement *! @[lfun::`[..]] but @[lfun::`[]] then the latter is called *! with the bounds transformed to normal from-the-beginning *! indices in array-like fashion: *! *! @dl
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_BEG, j, Pike.INDEX_FROM_BEG)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (i, j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_BEG, j, Pike.INDEX_FROM_END)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (i, a->_sizeof()-1-j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_BEG, 0, Pike.OPEN_BOUND)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (i, @[Int.NATIVE_MAX])@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_END, j, Pike.INDEX_FROM_BEG)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (a->_sizeof()-1-i, j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_END, j, Pike.INDEX_FROM_END)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (a->_sizeof()-1-i, a->_sizeof()-1-j)@}, *! except that @expr{a->_sizeof()@} is called only once.
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_END, 0, Pike.OPEN_BOUND)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (a->_sizeof()-1-i, @[Int.NATIVE_MAX])@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, 0, Pike.OPEN_BOUND, j, Pike.INDEX_FROM_BEG)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (0, j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, 0, Pike.OPEN_BOUND, j, Pike.INDEX_FROM_END)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (0, a->_sizeof()-1-j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, 0, Pike.OPEN_BOUND, 0, Pike.OPEN_BOUND)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (0, @[Int.NATIVE_MAX])@} *! @enddl *! *! Note that @[Int.NATIVE_MAX] might be replaced with an even *! larger integer in the future. *! @endmixed *! *! @seealso *! @[lfun::`[..]], @[`[]] */ PMOD_EXPORT void f_range(INT32 args) { struct svalue *ind; if (args != 5) SIMPLE_WRONG_NUM_ARGS_ERROR ("predef::`[..]", 5); ind = sp - 5; #define CALC_BOUND_TYPES(bound_types) do { \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(ind[2]) != T_INT) \
408a1e2004-10-30Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("predef::`[..]", 3, "int"); \ switch (ind[2].u.integer) { \ case INDEX_FROM_BEG: bound_types = RANGE_LOW_FROM_BEG; break; \ case INDEX_FROM_END: bound_types = RANGE_LOW_FROM_END; break; \ case OPEN_BOUND: bound_types = RANGE_LOW_OPEN; break; \ default: \ SIMPLE_ARG_ERROR ("predef::`[..]", 3, "Unrecognized bound type."); \ } \ \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(ind[4]) != T_INT) \
408a1e2004-10-30Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("predef::`[..]", 5, "int"); \ switch (ind[4].u.integer) { \ case INDEX_FROM_BEG: bound_types |= RANGE_HIGH_FROM_BEG; break; \ case INDEX_FROM_END: bound_types |= RANGE_HIGH_FROM_END; break; \ case OPEN_BOUND: bound_types |= RANGE_HIGH_OPEN; break; \ default: \ SIMPLE_ARG_ERROR ("predef::`[..]", 5, "Unrecognized bound type."); \ } \ } while (0)
017b572011-10-28Henrik Grubbström (Grubba)  switch (TYPEOF(*ind)) {
408a1e2004-10-30Martin Stjernholm  case T_OBJECT: { struct object *o = ind->u.object; int f; if (!o->prog) SIMPLE_ARG_ERROR ("predef::`[..]", 1, "Cannot call `[..] in destructed object.\n");
017b572011-10-28Henrik Grubbström (Grubba)  if ((f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(*ind)].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN_RANGE)) != -1) {
408a1e2004-10-30Martin Stjernholm  apply_low (o, f, 4); stack_pop_keep_top(); } else { int bound_types; CALC_BOUND_TYPES (bound_types); switch (call_old_range_lfun (bound_types, o, ind + 1, ind + 3)) { case 1: SIMPLE_ARG_ERROR ("predef::`[..]", 1, "Object got neither `[..] nor `[].\n"); case 2: SIMPLE_ARG_ERROR ("predef::`[..]", 1, "Object got no `[..] and there is no _sizeof to " "translate the from-the-end index to use `[].\n"); case 3: SIMPLE_ARG_ERROR ("predef::`[..]", 1, "Cannot call `[..] in destructed object.\n"); default: free_svalue (ind); move_svalue (ind, sp - 1); /* The bound types are simple integers and the bounds * themselves have lost their refs in call_old_range_lfun. */ sp = ind + 1; } } break; } case T_STRING: case T_ARRAY: {
ec51ce2006-04-25David Hedbor  INT_TYPE l=0, h=0;
408a1e2004-10-30Martin Stjernholm  int bound_types; CALC_BOUND_TYPES (bound_types); if (!(bound_types & RANGE_LOW_OPEN)) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(ind[1]) != T_INT)
408a1e2004-10-30Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("predef::`[..]", 2, "int"); l = ind[1].u.integer; } if (!(bound_types & RANGE_HIGH_OPEN)) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(ind[3]) != T_INT)
408a1e2004-10-30Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("predef::`[..]", 4, "int"); h = ind[3].u.integer; } pop_n_elems (4); string_or_array_range (bound_types, ind, l, h); break; } default: SIMPLE_ARG_TYPE_ERROR ("predef::`[..]", 1, "string|array|object");
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) 
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `[](object arg, mixed index) *! @decl mixed `[](object arg, string index)
408a1e2004-10-30Martin Stjernholm  *! @decl function `[](int arg, string index) *! @decl int `[](string arg, int index)
8d1b862001-02-08Henrik Grubbström (Grubba)  *! @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 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)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
408a1e2004-10-30Martin Stjernholm  *! Indexing.
dfceb02003-11-10Martin Stjernholm  *!
408a1e2004-10-30Martin Stjernholm  *! This is the function form of expressions with the @expr{[]@} *! operator, i.e. @expr{a[i]@} is the same as *! @expr{predef::`[](a,i)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns
408a1e2004-10-30Martin Stjernholm  *! If @[arg] is an object that implements @[lfun::`[]()], that *! function is called with the @[index] argument. *! *! Otherwise, the action depends on the type of @[arg]:
28984e2001-05-09Henrik Grubbström (Grubba)  *!
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type object
30c0612008-06-29Martin Stjernholm  *! The non-protected (i.e. public) symbol named @[index] is *! looked up in @[arg].
408a1e2004-10-30Martin Stjernholm  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type int
408a1e2004-10-30Martin Stjernholm  *! The bignum function named @[index] is looked up in @[arg]. *! The bignum functions are the same as those in the @[Gmp.mpz] *! class. *! *! @type string *! The character at index @[index] in @[arg] is returned as an *! integer. The first character in the string is at index *! @expr{0@} and the highest allowed index is therefore *! @expr{sizeof(@[arg])-1@}. A negative index number accesses *! the string from the end instead, from @expr{-1@} for the *! last char back to @expr{-sizeof(@[arg])@} for the first. *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type array
408a1e2004-10-30Martin Stjernholm  *! If @[index] is an int, index number @[index] of @[arg] is *! returned. Allowed index number are in the range *! @expr{[-sizeof(@[arg])..sizeof(@[arg])-1]@}; see the string *! case above for details. *! *! If @[index] is not an int, an array of all elements in *! @[arg] indexed with @[index] are returned. I.e. it's the *! same as doing @expr{column(@[arg], @[index])@}. *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type mapping
408a1e2004-10-30Martin Stjernholm  *! If @[index] exists in @[arg] the corresponding value is *! returned. Otherwise @expr{UNDEFINED@} is returned. *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type multiset
408a1e2004-10-30Martin Stjernholm  *! If @[index] exists in @[arg], @expr{1@} is returned. *! Otherwise @expr{UNDEFINED@} is returned. *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type program
30c0612008-06-29Martin Stjernholm  *! The non-protected (i.e. public) constant symbol @[index] is
28984e2001-05-09Henrik Grubbström (Grubba)  *! looked up in @[arg]. *! *! @endmixed
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
408a1e2004-10-30Martin Stjernholm  *! As a compatibility measure, this function also performs range *! operations if it's called with three arguments. In that case it *! becomes equivalent to: *! *! @code *! @[`[..]] (arg, start, @[Pike.INDEX_FROM_BEG], end, @[Pike.INDEX_FROM_BEG]) *! @endcode *! *! See @[`[..]] for further details. *!
dfceb02003-11-10Martin Stjernholm  *! @note *! An indexing expression in an lvalue context, i.e. where the *! index is being assigned a new value, uses @[`[]=] instead of *! this function. *!
8d1b862001-02-08Henrik Grubbström (Grubba)  *! @seealso
408a1e2004-10-30Martin Stjernholm  *! @[`->()], @[lfun::`[]()], @[`[]=], @[`[..]]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_index(INT32 args)
9f68471997-03-08Fredrik Hübinette (Hubbe) { switch(args) { case 2:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_STRING) SET_SVAL_SUBTYPE(sp[-1], 0);
9f68471997-03-08Fredrik Hübinette (Hubbe)  o_index(); break; case 3:
408a1e2004-10-30Martin Stjernholm  move_svalue (sp, sp - 1); sp += 2;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, INDEX_FROM_BEG); sp[-3] = sp[-1];
408a1e2004-10-30Martin Stjernholm  f_range (5);
9f68471997-03-08Fredrik Hübinette (Hubbe)  break; default:
408a1e2004-10-30Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("predef::`[]", args); break;
9f68471997-03-08Fredrik Hübinette (Hubbe)  } }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @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)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
408a1e2004-10-30Martin Stjernholm  *! Arrow indexing.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @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:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type object
30c0612008-06-29Martin Stjernholm  *! The non-protected (ie public) symbol named @[index] will be *! looked up in @[arg].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @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
cbe8c92003-04-07Martin Nilsson  *! returned. Otherwise @expr{UNDEFINED@} will be returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type multiset
cbe8c92003-04-07Martin Nilsson  *! If @[index] exists in @[arg], @expr{1@} will be returned. *! Otherwise @expr{UNDEFINED@} will be returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type program
30c0612008-06-29Martin Stjernholm  *! The non-protected (ie public) constant symbol @[index] will *! be looked up in @[arg].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! @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. *!
8d1b862001-02-08Henrik Grubbström (Grubba)  *! @seealso
dfceb02003-11-10Martin Stjernholm  *! @[`[]()], @[lfun::`->()], @[::`->()], @[`->=]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_arrow(INT32 args)
9f68471997-03-08Fredrik Hübinette (Hubbe) { switch(args) { case 0: case 1:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`->", "Too few arguments.\n", sp, args);
9f68471997-03-08Fredrik Hübinette (Hubbe)  break; case 2:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_STRING) SET_SVAL_SUBTYPE(sp[-1], 1);
9f68471997-03-08Fredrik Hübinette (Hubbe)  o_index(); break; default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`->", "Too many arguments.\n", sp, args);
9f68471997-03-08Fredrik Hübinette (Hubbe)  } }
d07e182001-02-08Henrik Grubbström (Grubba) /*! @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)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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)@}.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg] is an object that implements @[lfun::`[]=()], that function *! will be called with @[index] and @[val] as the arguments.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type object
30c0612008-06-29Martin Stjernholm  *! The non-protected (ie public) variable named @[index] will *! be looked up in @[arg], and assigned @[val].
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type array|mapping
28984e2001-05-09Henrik Grubbström (Grubba)  *! Index @[index] in @[arg] will be assigned @[val]. *! @type multiset
cbe8c92003-04-07Martin Nilsson  *! If @[val] is @expr{0@} (zero), one occurrance of @[index] in
28984e2001-05-09Henrik Grubbström (Grubba)  *! @[arg] will be removed. Otherwise @[index] will be added *! to @[arg] if it is not already there. *! @endmixed
d07e182001-02-08Henrik Grubbström (Grubba)  *! *! @returns *! @[val] will be returned. *!
dfceb02003-11-10Martin Stjernholm  *! @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. *!
d07e182001-02-08Henrik Grubbström (Grubba)  *! @seealso
dfceb02003-11-10Martin Stjernholm  *! @[`->=()], @[lfun::`[]=()], @[`[]]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_index_assign(INT32 args)
912f171999-08-16Martin Stjernholm { switch (args) { case 0: case 1: case 2: PIKE_ERROR("`[]=", "Too few arguments.\n", sp, args); break; case 3:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) == T_STRING) SET_SVAL_SUBTYPE(sp[-2], 0);
4856a81999-08-17Martin Stjernholm  assign_lvalue (sp-3, sp-1);
e956bb2008-07-11Martin Stjernholm  stack_pop_n_elems_keep_top (2);
912f171999-08-16Martin Stjernholm  break; default: PIKE_ERROR("`[]=", "Too many arguments.\n", sp, args); } }
d07e182001-02-08Henrik Grubbström (Grubba) /*! @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)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Arrow index assignment.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! 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.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg] is an object that implements @[lfun::`->=()], that function *! will be called with @[index] and @[val] as the arguments.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type object
30c0612008-06-29Martin Stjernholm  *! The non-protected (ie public) variable named @[index] will *! be looked up in @[arg], and assigned @[val].
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type array|mapping
28984e2001-05-09Henrik Grubbström (Grubba)  *! Index @[index] in @[arg] will be assigned @[val]. *! @type multiset
cbe8c92003-04-07Martin Nilsson  *! If @[val] is @expr{0@} (zero), one occurrance of @[index] in
28984e2001-05-09Henrik Grubbström (Grubba)  *! @[arg] will be removed. Otherwise @[index] will be added *! to @[arg] if it is not already there. *! @endmixed
d07e182001-02-08Henrik Grubbström (Grubba)  *! *! @returns *! @[val] will be returned. *!
dfceb02003-11-10Martin Stjernholm  *! @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. *!
d07e182001-02-08Henrik Grubbström (Grubba)  *! @seealso
dfceb02003-11-10Martin Stjernholm  *! @[`[]=()], @[lfun::`->=()], @[`->]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_arrow_assign(INT32 args)
4856a81999-08-17Martin Stjernholm { switch (args) { case 0: case 1: case 2: PIKE_ERROR("`->=", "Too few arguments.\n", sp, args); break; case 3:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) == T_STRING) SET_SVAL_SUBTYPE(sp[-2], 1);
4856a81999-08-17Martin Stjernholm  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); } }
d07e182001-02-08Henrik Grubbström (Grubba) /*! @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) *!
dfceb02003-11-10Martin Stjernholm  *! Size query.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns *! The result will be as follows:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type string *! The number of characters in @[arg] will be returned.
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type array|multiset
28984e2001-05-09Henrik Grubbström (Grubba)  *! 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
30c0612008-06-29Martin Stjernholm  *! be called. Otherwise the number of non-protected (ie public)
28984e2001-05-09Henrik Grubbström (Grubba)  *! symbols in @[arg] will be returned. *! @endmixed
d07e182001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[lfun::_sizeof()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_sizeof(INT32 args)
4c573c1996-08-03Fredrik Hübinette (Hubbe) { INT32 tmp; if(args<1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("sizeof", "Too few arguments.\n", sp, args);
4c573c1996-08-03Fredrik Hübinette (Hubbe) 
06983f1996-09-22Fredrik Hübinette (Hubbe)  tmp=pike_sizeof(sp-args);
4c573c1996-08-03Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(tmp); }
79d2b42001-05-19Henrik Grubbström (Grubba) static node *optimize_sizeof(node *n) { if (CDR(n) && (CDR(n)->token == F_APPLY) && (CADR(n)) && (CADR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CADR(n)->u.sval) == T_FUNCTION) && (SUBTYPEOF(CADR(n)->u.sval) == FUNCTION_BUILTIN)) {
79d2b42001-05-19Henrik Grubbström (Grubba)  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) &&
a0c96c2007-03-20Henrik Grubbström (Grubba)  CADDR(n) && pike_types_le(CADDR(n)->type, string_type_string) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  CDDDR(n) && (CDDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDDR(n)->u.sval) == T_STRING) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CDDDR(n)->u.sval.u.string->len == 1)) { p_wchar2 split = index_shared_string(CDDDR(n)->u.sval.u.string, 0);
eed2da2001-06-11Henrik Grubbström (Grubba) 
79d2b42001-05-19Henrik Grubbström (Grubba)  /* 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) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CAADDR(n)->u.sval) == T_FUNCTION) && (SUBTYPEOF(CAADDR(n)->u.sval) == FUNCTION_BUILTIN) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CAADDR(n)->u.sval.u.efun->function == f_divide) && CDADDR(n) && (CDADDR(n)->token == F_ARG_LIST) &&
a0c96c2007-03-20Henrik Grubbström (Grubba)  CADADDR(n) && pike_types_le(CADADDR(n)->type, string_type_string) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  CDDADDR(n) && (CDDADDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDADDR(n)->u.sval) == T_STRING) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CDDADDR(n)->u.sval.u.string->len == 1) && CDDDR(n)) { /* sizeof(`-(`/(str, "x"), y)) */ if (((CDDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDDR(n)->u.sval) == T_ARRAY) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CDDDR(n)->u.sval.u.array->size == 1) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDDR(n)->u.sval.u.array->item[0]) == T_STRING) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CDDDR(n)->u.sval.u.array->item[0].u.string->len == 0)) || ((CDDDR(n)->token == F_APPLY) && CADDDR(n) && (CADDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CADDDR(n)->u.sval) == T_FUNCTION) && (SUBTYPEOF(CADDDR(n)->u.sval) == FUNCTION_BUILTIN) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CADDDR(n)->u.sval.u.efun->function == f_allocate) && CDDDDR(n) && (CDDDDR(n)->token == F_ARG_LIST) && CADDDDR(n) && (CADDDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CADDDDR(n)->u.sval) == T_INT) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CADDDDR(n)->u.sval.u.integer == 1) && CDDDDDR(n) && (CDDDDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDDDDR(n)->u.sval) == T_STRING) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (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; }
4c573c1996-08-03Fredrik Hübinette (Hubbe) static int generate_sizeof(node *n) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
4c573c1996-08-03Fredrik Hübinette (Hubbe)  if(count_args(CDR(n)) != 1) return 0; if(do_docode(CDR(n),DO_NOT_COPY) != 1)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Count args was wrong in sizeof().\n");
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_SIZEOF);
4c573c1996-08-03Fredrik Hübinette (Hubbe)  return 1; }
4f20e92001-01-25Fredrik Hübinette (Hubbe) extern int generate_call_function(node *n);
f09ec92001-02-07Henrik Grubbström (Grubba) 
aba09a2011-12-28Henrik Grubbström (Grubba) /*! @decl void _Static_assert(int constant_expression, string constant_message) *! *! Perform a compile-time assertion check. *! *! If @[constant_expression] is false, a compiler error message *! containing @[constant_message] will be generated. *! *! @note *! Note that the function call compiles to the null statement, *! and thus does not affect the run-time. *! *! @seealso *! @[cpp::static_assert] */ static int generate__Static_assert(node *n) { struct compilation *c = THIS_COMPILATION; ptrdiff_t tmp; node **expr = my_get_arg(&_CDR(n), 0); node **msg = my_get_arg(&_CDR(n), 1); if(!expr || !msg || count_args(CDR(n)) != 2) { yyerror("Bad number of arguments to _Static_assert()."); return 1; } tmp = eval_low(*msg, 0); if (tmp < 1) { yyerror("Argument 2 to _Static_assert() is not constant."); return 1; } if (tmp > 1) pop_n_elems(tmp-1); if (TYPEOF(Pike_sp[-1]) != T_STRING) { yyerror("Bad argument 2 to _Static_assert(), expected string."); return 1; } tmp = eval_low(*expr, 0); if (tmp < 1) { pop_stack(); yyerror("Argument 1 to _Static_assert is not constant."); return 1; } if (tmp > 1) pop_n_elems(tmp-1); if (SAFE_IS_ZERO(Pike_sp-1)) { my_yyerror("Assertion failed: %S", Pike_sp[-2].u.string); } pop_n_elems(2); return 1; }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @class string_assignment */
19aaeb1998-05-25Fredrik Hübinette (Hubbe) struct program *string_assignment_program; #undef THIS
60d9872000-03-23Fredrik Hübinette (Hubbe) #define THIS ((struct string_assignment_storage *)(CURRENT_STORAGE))
da95392005-04-08Henrik Grubbström (Grubba) /*! @decl int `[](int i)
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! String index operator. */
19aaeb1998-05-25Fredrik Hübinette (Hubbe) static void f_string_assignment_index(INT32 args) {
da95392005-04-08Henrik Grubbström (Grubba)  ptrdiff_t len;
639cfa2003-05-15Martin Stjernholm  INT_TYPE i, p;
da95392005-04-08Henrik Grubbström (Grubba)  get_all_args("string[]", args, "%i", &p); if (!THIS->s) { Pike_error("Indexing uninitialized string_assignment.\n"); } len = THIS->s->len;
639cfa2003-05-15Martin Stjernholm  i = p < 0 ? p + len : p; if(i<0 || i>=len)
b99d882003-05-15Martin Stjernholm  Pike_error("Index %"PRINTPIKEINT"d is out of string range "
639cfa2003-05-15Martin Stjernholm  "%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n", p, -len, len - 1);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  else
b987f91998-10-12Fredrik Hübinette (Hubbe)  i=index_shared_string(THIS->s,i);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(i); }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @decl int `[]=(int i, int j) *! *! String assign index operator. */
19aaeb1998-05-25Fredrik Hübinette (Hubbe) static void f_string_assignment_assign_index(INT32 args) {
639cfa2003-05-15Martin Stjernholm  INT_TYPE p, i, j;
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  union anything *u;
639cfa2003-05-15Martin Stjernholm  ptrdiff_t len; get_all_args("string[]=",args,"%i%i",&p,&j);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  if((u=get_pointer_if_this_type(THIS->lval, T_STRING))) {
639cfa2003-05-15Martin Stjernholm  len = u->string->len; i = p < 0 ? p + len : p; if(i<0 || i>=len)
b99d882003-05-15Martin Stjernholm  Pike_error("Index %"PRINTPIKEINT"d is out of string range "
639cfa2003-05-15Martin Stjernholm  "%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n", p, -len, len - 1);
da95392005-04-08Henrik Grubbström (Grubba)  if (THIS->s) free_string(THIS->s);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  u->string=modify_shared_string(u->string,i,j); copy_shared_string(THIS->s, u->string);
639cfa2003-05-15Martin Stjernholm  } else{
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  lvalue_to_svalue_no_free(sp,THIS->lval); sp++;
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_STRING) Pike_error("string[]= failed.\n");
639cfa2003-05-15Martin Stjernholm  len = sp[-1].u.string->len; i = p < 0 ? p + len : p; if(i<0 || i>=len)
b99d882003-05-15Martin Stjernholm  Pike_error("Index %"PRINTPIKEINT"d is out of string range "
639cfa2003-05-15Martin Stjernholm  "%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n", p, -len, len - 1);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  sp[-1].u.string=modify_shared_string(sp[-1].u.string,i,j); assign_lvalue(THIS->lval, sp-1); pop_stack(); }
639cfa2003-05-15Martin Stjernholm 
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(j); }
57ed3f2012-12-30Jonas Walldén static void init_string_assignment_storage(struct object *UNUSED(o))
19aaeb1998-05-25Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(THIS->lval[0], T_INT, PIKE_T_FREE, integer, 0); SET_SVAL(THIS->lval[1], T_INT, PIKE_T_FREE, integer, 0);
da95392005-04-08Henrik Grubbström (Grubba)  THIS->s = NULL;
19aaeb1998-05-25Fredrik Hübinette (Hubbe) }
57ed3f2012-12-30Jonas Walldén static void exit_string_assignment_storage(struct object *UNUSED(o))
19aaeb1998-05-25Fredrik Hübinette (Hubbe) { free_svalues(THIS->lval, 2, BIT_MIXED); if(THIS->s) free_string(THIS->s); }
b1f4eb1998-01-13Fredrik Hübinette (Hubbe) 
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @endclass */
be478c1997-08-30Henrik Grubbström (Grubba) void init_operators(void)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) {
408a1e2004-10-30Martin Stjernholm  ADD_EFUN ("`[..]", f_range, tOr3(tFunc(tStr tInt tRangeBound tInt tRangeBound, tStr), tFunc(tArr(tSetvar(0,tMix)) tInt tRangeBound tInt tRangeBound, tArr(tVar(0))), tFunc(tObj tMix tRangeBound tMix tRangeBound, tMix)), OPT_TRY_OPTIMIZE); ADD_INT_CONSTANT ("INDEX_FROM_BEG", INDEX_FROM_BEG, 0); ADD_INT_CONSTANT ("INDEX_FROM_END", INDEX_FROM_END, 0); ADD_INT_CONSTANT ("OPEN_BOUND", OPEN_BOUND, 0); ADD_EFUN ("`[]", f_index, tOr9(tFunc(tObj tMix tOr(tVoid,tMix), tMix), tFunc(tInt tString, tFunction), tFunc(tStr tInt, tInt), tFunc(tArr(tSetvar(0,tMix)) tMix, tVar(0)), tFunc(tMap(tMix,tSetvar(1,tMix)) tMix, tVar(1)), tFunc(tMultiset tMix, tInt01), tFunc(tPrg(tObj) tString, tMix), tFunc(tStr tInt tInt, tStr), tFunc(tArr(tSetvar(2,tMix)) tInt tInt, tArr(tVar(2)))), OPT_TRY_OPTIMIZE);
9f68471997-03-08Fredrik Hübinette (Hubbe) 
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(array(object|mapping|multiset|array),string:array(mixed))|function(object|mapping|multiset|program,string:mixed) */
8c953a2001-03-28Henrik Grubbström (Grubba)  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);
9f68471997-03-08Fredrik Hübinette (Hubbe) 
912f171999-08-16Martin Stjernholm  ADD_EFUN("`[]=", f_index_assign,
4856a81999-08-17Martin Stjernholm  tOr4(tFunc(tObj tStr tSetvar(0,tMix), tVar(0)),
912f171999-08-16Martin Stjernholm  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))),
6f1d412000-04-08Henrik Grubbström (Grubba)  OPT_SIDE_EFFECT|OPT_TRY_OPTIMIZE);
912f171999-08-16Martin Stjernholm 
4856a81999-08-17Martin Stjernholm  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))),
6f1d412000-04-08Henrik Grubbström (Grubba)  OPT_SIDE_EFFECT|OPT_TRY_OPTIMIZE);
4856a81999-08-17Martin Stjernholm 
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(mixed...:int) */
563fdc1999-12-27Henrik Grubbström (Grubba)  ADD_EFUN2("`==",f_eq,
bede052013-12-06Henrik Grubbström (Grubba)  tOr6(tFuncV(tOr(tInt,tFloat) tOr(tInt,tFloat),
563fdc1999-12-27Henrik Grubbström (Grubba)  tOr(tInt,tFloat),tInt01),
9bab981999-12-27Henrik Grubbström (Grubba)  tFuncV(tSetvar(0,tOr4(tString,tMapping,tMultiset,tArray)) tVar(0), tVar(0),tInt01),
8c953a2001-03-28Henrik Grubbström (Grubba)  tFuncV(tOr3(tObj,tPrg(tObj),tFunction) tMix,tMix,tInt01), tFuncV(tMix tOr3(tObj,tPrg(tObj),tFunction),tMix,tInt01),
54f8ac2001-03-17Henrik Grubbström (Grubba)  tFuncV(tType(tMix) tType(tMix),
bede052013-12-06Henrik Grubbström (Grubba)  tOr3(tPrg(tObj),tFunction,tType(tMix)),tInt01), tFuncV(tSetvar(0,tOr4(tString,tMapping,tMultiset,tArray)), tNot(tVar(0)),tInt0)),
25c28d1999-12-29Henrik Grubbström (Grubba)  OPT_WEAK_TYPE|OPT_TRY_OPTIMIZE,optimize_eq,generate_comparison);
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(mixed...:int) */
563fdc1999-12-27Henrik Grubbström (Grubba)  ADD_EFUN2("`!=",f_ne,
bede052013-12-06Henrik Grubbström (Grubba)  tOr6(tFuncV(tOr(tInt,tFloat) tOr(tInt,tFloat),
563fdc1999-12-27Henrik Grubbström (Grubba)  tOr(tInt,tFloat),tInt01),
9bab981999-12-27Henrik Grubbström (Grubba)  tFuncV(tSetvar(0,tOr4(tString,tMapping,tMultiset,tArray)) tVar(0), tVar(0),tInt01),
8c953a2001-03-28Henrik Grubbström (Grubba)  tFuncV(tOr3(tObj,tPrg(tObj),tFunction) tMix,tMix,tInt01), tFuncV(tMix tOr3(tObj,tPrg(tObj),tFunction),tMix,tInt01),
54f8ac2001-03-17Henrik Grubbström (Grubba)  tFuncV(tType(tMix) tType(tMix),
bede052013-12-06Henrik Grubbström (Grubba)  tOr3(tPrg(tObj),tFunction,tType(tMix)),tInt01), tFuncV(tSetvar(0,tOr4(tString,tMapping,tMultiset,tArray)), tNot(tVar(0)),tInt1)),
25c28d1999-12-29Henrik Grubbström (Grubba)  OPT_WEAK_TYPE|OPT_TRY_OPTIMIZE,0,generate_comparison);
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(mixed:int) */
563fdc1999-12-27Henrik Grubbström (Grubba)  ADD_EFUN2("`!",f_not,tFuncV(tMix,tVoid,tInt01), OPT_TRY_OPTIMIZE,optimize_not,generate_not);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) 
dc7d491999-12-15Henrik Grubbström (Grubba) #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))"
07c0731996-06-21Fredrik Hübinette (Hubbe)  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);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) 
76db651999-05-25Mirar (Pontus Hagland)  ADD_EFUN2("`+",f_add,
b62f3f2007-04-03Henrik Grubbström (Grubba)  tOr7(tIfnot(tFuncV(tNone,tNot(tOr(tObj,tMix)),tMix),
8aa4852007-04-03Henrik Grubbström (Grubba)  tFuncV(tNone,tMix,tMix)),
ad08af1999-05-25Mirar (Pontus Hagland)  tFuncV(tInt,tInt,tInt),
db1efe2000-12-15Henrik Grubbström (Grubba)  tIfnot(tFuncV(tNone, tNot(tFlt), tMix),
ad08af1999-05-25Mirar (Pontus Hagland)  tFuncV(tOr(tInt,tFlt),tOr(tInt,tFlt),tFlt)),
db1efe2000-12-15Henrik Grubbström (Grubba)  tIfnot(tFuncV(tNone, tNot(tStr), tMix),
1464862013-05-22Henrik Grubbström (Grubba)  tFuncV(tOr3(tSetvar(0, tStr),tInt,tFlt), tOr3(tSetvar(1, tStr),tInt,tFlt),tOr(tVar(0),tVar(1)))),
ad08af1999-05-25Mirar (Pontus Hagland)  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)))),
9e52381998-03-01Fredrik Hübinette (Hubbe)  OPT_TRY_OPTIMIZE,optimize_binary,generate_sum);
76db651999-05-25Mirar (Pontus Hagland)  ADD_EFUN2("`-",f_minus,
b62f3f2007-04-03Henrik Grubbström (Grubba)  tOr7(tIfnot(tFuncV(tNone,tNot(tOr(tObj,tMix)),tMix), tFuncV(tNone,tMix,tMix)),
76db651999-05-25Mirar (Pontus Hagland)  tFuncV(tInt,tInt,tInt),
4106cc2000-12-08Henrik Grubbström (Grubba)  tIfnot(tFuncV(tNone,tNot(tFlt),tMix),
76db651999-05-25Mirar (Pontus Hagland)  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)),
aa17e32000-04-12Mirar (Pontus Hagland)  tOr3(tMapping,tArray,tMultiset), tMap(tVar(1),tVar(2))),
76db651999-05-25Mirar (Pontus Hagland)  tFunc(tSet(tSetvar(3,tMix)) tMultiset,tSet(tVar(3))),
1464862013-05-22Henrik Grubbström (Grubba)  tFuncV(tSetvar(0,tStr),tStr,tVar(0))),
1eaa381998-03-04Fredrik Hübinette (Hubbe)  OPT_TRY_OPTIMIZE,0,generate_minus);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) 
aa17e32000-04-12Mirar (Pontus Hagland) /* 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)), \
68155a2007-03-31Henrik Grubbström (Grubba)  tIfnot(tFuncV(tNone, tNot(Z), tMix), \
aa17e32000-04-12Mirar (Pontus Hagland)  tFuncV(tSetvar(1,Z),tSetvar(2,Z), \ tOr(tVar(1),tVar(2)))))
ef2b4e1999-12-18Martin Stjernholm  ADD_EFUN2("`&",f_and,
aa17e32000-04-12Mirar (Pontus Hagland)  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),
8c953a2001-03-28Henrik Grubbström (Grubba)  F_AND_TYPE(tOr(tType(tMix),tPrg(tObj))) ),
aa17e32000-04-12Mirar (Pontus Hagland) 
db1efe2000-12-15Henrik Grubbström (Grubba)  tIfnot(tFuncV(tNone, tNot(tMapping), tMix),
aa17e32000-04-12Mirar (Pontus Hagland)  tFuncV(tNone, tOr3(tArray,tMultiset,tSetvar(4,tMapping)), tVar(4)) ) ),
ef2b4e1999-12-18Martin Stjernholm  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), \
8c953a2001-03-28Henrik Grubbström (Grubba)  tFuncV(tOr(tType(tMix),tPrg(tObj)),tOr(tType(tMix),tPrg(tObj)),tType(tMix)))
ef2b4e1999-12-18Martin Stjernholm  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 \
dfe24d2014-02-16Henrik Grubbström (Grubba)  tOr3(tIfnot(tFuncV(tNone, tNot(tObj), tMix), \ tOr(tFunc(tMix tObj,tMix), \ tFunc(tObj tMix,tMix))), \ tIfnot(tFuncV(tNone, tNot(tInt), tMix), \ tFunc(tInt tInt, tInt)), \ tFunc(tIntPos tIntPos, tIntPos))
ef2b4e1999-12-18Martin Stjernholm 
9d4cae2002-06-17Henrik Grubbström (Grubba)  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);
07c0731996-06-21Fredrik Hübinette (Hubbe) 
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* !function(!object...:mixed)&function(mixed...:mixed)|"
1eaa381998-03-04Fredrik Hübinette (Hubbe)  "function(array(array(1=mixed)),array(1=mixed):array(1))|"
1b61661998-02-19Fredrik Hübinette (Hubbe)  "function(int...:int)|" "!function(int...:mixed)&function(float|int...:float)|" "function(string*,string:string)|"
1eaa381998-03-04Fredrik Hübinette (Hubbe)  "function(array(0=mixed),int:array(0))|"
3a3bc32000-09-26Henrik Wallin  "function(array(0=mixed),float:array(0))|" "function(string,int:string) "function(string,float:string) */
4106cc2000-12-08Henrik Grubbström (Grubba)  ADD_EFUN2("`*", f_multiply,
7b3ce12008-01-09Henrik Grubbström (Grubba)  tOr9(tIfnot(tFuncV(tNone,tNot(tOr(tObj,tMix)),tMix), tFuncV(tNone,tOr(tMix,tVoid),tMix)),
ad08af1999-05-25Mirar (Pontus Hagland)  tFunc(tArr(tArr(tSetvar(1,tMix))) tArr(tSetvar(1,tMix)),tArr(tVar(1))), tFuncV(tInt,tInt,tInt),
4106cc2000-12-08Henrik Grubbström (Grubba)  tIfnot(tFuncV(tNone,tNot(tFlt),tMix),
ad08af1999-05-25Mirar (Pontus Hagland)  tFuncV(tOr(tFlt,tInt),tOr(tFlt,tInt),tFlt)), tFunc(tArr(tStr) tStr,tStr), tFunc(tArr(tSetvar(0,tMix)) tInt,tArr(tVar(0))),
3a3bc32000-09-26Henrik Wallin  tFunc(tArr(tSetvar(0,tMix)) tFlt,tArr(tVar(0))),
a0c96c2007-03-20Henrik Grubbström (Grubba)  tFunc(tSetvar(0, tStr) tInt,tVar(0)), tFunc(tSetvar(0, tStr) tFlt,tVar(0))),
1b61661998-02-19Fredrik Hübinette (Hubbe)  OPT_TRY_OPTIMIZE,optimize_binary,generate_multiply);
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* !function(!object...:mixed)&function(mixed...:mixed)|"
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  "function(int,int...:int)|" "!function(int...:mixed)&function(float|int...:float)|"
1eaa381998-03-04Fredrik Hübinette (Hubbe)  "function(array(0=mixed),array|int|float...:array(array(0)))|"
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  "function(string,string|int|float...:array(string)) */
4106cc2000-12-08Henrik Grubbström (Grubba)  ADD_EFUN2("`/", f_divide,
cba1092007-04-26Henrik Grubbström (Grubba)  tOr5(tIfnot(tFuncV(tNone,tNot(tOr(tObj,tMix)),tMix), tFuncV(tNone,tMix,tMix)),
4106cc2000-12-08Henrik Grubbström (Grubba)  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))),
1b61661998-02-19Fredrik Hübinette (Hubbe)  OPT_TRY_OPTIMIZE,0,generate_divide);
07c0731996-06-21Fredrik Hübinette (Hubbe) 
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(mixed,object:mixed)|"
d429a71998-02-24Fredrik Hübinette (Hubbe)  "function(object,mixed:mixed)|" "function(int,int:int)|" "function(string,int:string)|"
1eaa381998-03-04Fredrik Hübinette (Hubbe)  "function(array(0=mixed),int:array(0))|"
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  "!function(int,int:mixed)&function(int|float,int|float:float) */
db1efe2000-12-15Henrik Grubbström (Grubba)  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))),
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  OPT_TRY_OPTIMIZE,0,generate_mod);
07c0731996-06-21Fredrik Hübinette (Hubbe) 
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(object:mixed)|function(int:int)|function(float:float)|function(string:string) */
0e801c1999-12-13Henrik Grubbström (Grubba)  ADD_EFUN2("`~",f_compl,
0158bf2001-03-17Henrik Grubbström (Grubba)  tOr6(tFunc(tObj,tMix),
0e801c1999-12-13Henrik Grubbström (Grubba)  tFunc(tInt,tInt), tFunc(tFlt,tFlt), tFunc(tStr,tStr),
0158bf2001-03-17Henrik Grubbström (Grubba)  tFunc(tType(tSetvar(0, tMix)), tType(tNot(tVar(0)))),
8c953a2001-03-28Henrik Grubbström (Grubba)  tFunc(tPrg(tObj), tType(tMix))),
0e801c1999-12-13Henrik Grubbström (Grubba)  OPT_TRY_OPTIMIZE,0,generate_compl);
f8f0d62013-01-01Henrik Grubbström (Grubba)  /* function(string|multiset|array|mapping|object:int(0..)) */
57773f2001-02-05Henrik Grubbström (Grubba)  ADD_EFUN2("sizeof", f_sizeof,
f8f0d62013-01-01Henrik Grubbström (Grubba)  tFunc(tOr5(tStr,tMultiset,tArray,tMapping,tObj),tIntPos),
79d2b42001-05-19Henrik Grubbström (Grubba)  OPT_TRY_OPTIMIZE, optimize_sizeof, generate_sizeof);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe) 
7ed8da2013-11-02Martin Nilsson  ADD_EFUN2("strlen", f_sizeof, tFunc(tStr,tIntPos), OPT_TRY_OPTIMIZE, optimize_sizeof, generate_sizeof);
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(mixed,mixed ...:mixed) */ ADD_EFUN2("`()",f_call_function,tFuncV(tMix,tMix,tMix),OPT_SIDE_EFFECT | OPT_EXTERNAL_DEPEND,0,generate_call_function);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  /* This one should be removed */
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* 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);
19aaeb1998-05-25Fredrik Hübinette (Hubbe) 
aba09a2011-12-28Henrik Grubbström (Grubba)  /* From the 201x C standard */ ADD_EFUN2("_Static_assert", NULL, tFunc(tInt tStr, tVoid), OPT_TRY_OPTIMIZE, NULL, generate__Static_assert);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  start_new_program();
90e9781999-01-31Fredrik Hübinette (Hubbe)  ADD_STORAGE(struct string_assignment_storage);
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(int:int) */
2ff9602000-08-31Henrik Grubbström (Grubba)  ADD_FUNCTION2("`[]", f_string_assignment_index, tFunc(tInt,tInt), 0, OPT_EXTERNAL_DEPEND);
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(int,int:int) */
2ff9602000-08-31Henrik Grubbström (Grubba)  ADD_FUNCTION2("`[]=", f_string_assignment_assign_index, tFunc(tInt tInt,tInt), 0, OPT_SIDE_EFFECT);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  set_init_callback(init_string_assignment_storage); set_exit_callback(exit_string_assignment_storage); string_assignment_program=end_program(); }
aa711e1998-06-06Henrik Grubbström (Grubba) void exit_operators(void)
19aaeb1998-05-25Fredrik Hübinette (Hubbe) { if(string_assignment_program) { free_program(string_assignment_program); string_assignment_program=0; }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) }
6898c02003-11-14Martin Stjernholm  void o_breakpoint(void) { /* Does nothing */ }