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" #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"
e021fe2008-04-14Henrik Grubbström (Grubba) #include "pike_compiler.h"
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) 
54db6c1999-03-27Henrik Grubbström (Grubba) #define OP_DIVISION_BY_ZERO_ERROR(FUNC) \
3efc852018-02-19Martin Nilsson  math_error(FUNC, 2, 0, "Division by zero.\n")
54db6c1999-03-27Henrik Grubbström (Grubba) #define OP_MODULO_BY_ZERO_ERROR(FUNC) \
3efc852018-02-19Martin Nilsson  math_error(FUNC, 2, 0, "Modulo by zero.\n")
54db6c1999-03-27Henrik Grubbström (Grubba) 
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 
8580bb2017-01-02Martin Nilsson static int has_lfun(enum LFUN lfun, int arg);
c17a082017-01-02Martin Nilsson static int call_lfun(enum LFUN left, enum LFUN right);
8580bb2017-01-02Martin Nilsson static int call_lhs_lfun(enum LFUN lfun, int arg);
b83b372016-12-31Martin Nilsson 
6898c02003-11-14Martin Stjernholm void index_no_free(struct svalue *to,struct svalue *what,struct svalue *ind) {
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; }
5f50842018-02-12Marcus Comstedt  /* FALLTHRU */
6898c02003-11-14Martin Stjernholm  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;
19961b2017-04-08Martin Nilsson  index_no_free(&s,Pike_sp-2,Pike_sp-1);
6898c02003-11-14Martin Stjernholm  pop_n_elems(2);
19961b2017-04-08Martin Nilsson  *Pike_sp=s; dmalloc_touch_svalue(Pike_sp); Pike_sp++;
6898c02003-11-14Martin Stjernholm  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 {
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
6898c02003-11-14Martin Stjernholm  { case T_OBJECT:
19961b2017-04-08Martin Nilsson  if(!Pike_sp[-1].u.object->prog) {
ef8a142004-09-20Martin Stjernholm  /* Casting a destructed object should be like casting a zero. */ pop_stack(); push_int (0);
6898c02003-11-14Martin Stjernholm  }
b83b372016-12-31Martin Nilsson  else {
19961b2017-04-08Martin Nilsson  if( Pike_sp[-1].u.object->prog == bignum_program )
b83b372016-12-31Martin Nilsson  return;
ef8a142004-09-20Martin Stjernholm 
b83b372016-12-31Martin Nilsson  ref_push_string(literal_int_string); if(!call_lhs_lfun(LFUN_CAST,2)) Pike_error("No cast method in object <2>.\n"); stack_pop_keep_top(); /* pop object. */
ef8a142004-09-20Martin Stjernholm 
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) != PIKE_T_INT)
ef8a142004-09-20Martin Stjernholm  {
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) == T_OBJECT)
6898c02003-11-14Martin Stjernholm  {
19961b2017-04-08Martin Nilsson  struct object *o = Pike_sp[-1].u.object;
b83b372016-12-31Martin Nilsson  if( o->prog == bignum_program ) return; else if( o->prog ) { ref_push_string(literal_int_string); if( call_lhs_lfun(LFUN__IS_TYPE,2) )
19961b2017-04-08Martin Nilsson  if( !UNSAFE_IS_ZERO(Pike_sp-1) )
b83b372016-12-31Martin Nilsson  { pop_stack(); return; } pop_stack(); }
efd3792016-12-31Martin Nilsson  }
b83b372016-12-31Martin Nilsson  Pike_error("Cast failed, wanted int, got %s\n",
19961b2017-04-08Martin Nilsson  get_name_of_type(TYPEOF(Pike_sp[-1])));
6898c02003-11-14Martin Stjernholm  }
19961b2017-04-08Martin Nilsson  else if(SUBTYPEOF(Pike_sp[-1]) == NUMBER_UNDEFINED)
c43e8c2014-08-16Martin Nilsson  Pike_error("Cannot cast this object to int.\n");
6898c02003-11-14Martin Stjernholm  } break;
4998a92015-07-12Arne Goedeke  case T_FLOAT: {
19961b2017-04-08Martin Nilsson  FLOAT_TYPE f = Pike_sp[-1].u.float_number;
4998a92015-07-12Arne Goedeke 
10b43e2016-01-10Martin Nilsson  if ( PIKE_ISINF(f) || PIKE_ISNAN(f) )
4998a92015-07-12Arne Goedeke  Pike_error("Can't cast infinites or NaN to int.\n");
18678b2016-12-30Martin Nilsson  /* should perhaps convert to Int.Inf now that we have them? */
4998a92015-07-12Arne Goedeke  if (UNLIKELY(f > MAX_INT_TYPE || f < MIN_INT_TYPE)) { convert_stack_top_to_bignum(); } else {
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, f);
6898c02003-11-14Martin Stjernholm  }
4998a92015-07-12Arne Goedeke  break;
6898c02003-11-14Martin Stjernholm  }
13670c2015-05-25Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_STRING: /* The generic function is rather slow, so I added this * code for benchmark purposes. :-) /per */
19961b2017-04-08Martin Nilsson  if( (Pike_sp[-1].u.string->len >= 10) || Pike_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  {
19961b2017-04-08Martin Nilsson  INT_TYPE i = strtol(Pike_sp[-1].u.string->str, 0, 10); free_string(Pike_sp[-1].u.string); SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, i);
6898c02003-11-14Martin Stjernholm  } break; case PIKE_T_INT: break;
13670c2015-05-25Martin Nilsson 
6898c02003-11-14Martin Stjernholm  default:
19961b2017-04-08Martin Nilsson  Pike_error("Cannot cast %s to int.\n", get_name_of_type(TYPEOF(Pike_sp[-1])));
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
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;
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
6898c02003-11-14Martin Stjernholm  { case T_OBJECT:
19961b2017-04-08Martin Nilsson  if(!Pike_sp[-1].u.object->prog) {
ef8a142004-09-20Martin Stjernholm  /* Casting a destructed object should be like casting a zero. */ pop_stack();
af40e42004-09-20Henrik Grubbström (Grubba)  push_constant_text("0");
b83b372016-12-31Martin Nilsson  } else { ref_push_string(literal_string_string); if(!call_lhs_lfun(LFUN_CAST,2)) Pike_error("No cast method in object.\n"); stack_pop_keep_top();
ef8a142004-09-20Martin Stjernholm 
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) != PIKE_T_STRING)
ef8a142004-09-20Martin Stjernholm  {
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1])==PIKE_T_INT && SUBTYPEOF(Pike_sp[-1])==NUMBER_UNDEFINED)
c43e8c2014-08-16Martin Nilsson  Pike_error("Cannot cast this object to string.\n");
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) == T_OBJECT && Pike_sp[-1].u.object->prog)
6898c02003-11-14Martin Stjernholm  {
b83b372016-12-31Martin Nilsson  ref_push_string(literal_string_string); if( call_lhs_lfun( LFUN__IS_TYPE,2 ) )
19961b2017-04-08Martin Nilsson  if( !UNSAFE_IS_ZERO(Pike_sp-1) )
b83b372016-12-31Martin Nilsson  { pop_stack(); return; } pop_stack(); }
ef8a142004-09-20Martin Stjernholm  Pike_error("Cast failed, wanted string, got %s\n",
19961b2017-04-08Martin Nilsson  get_name_of_type(TYPEOF(Pike_sp[-1])));
6898c02003-11-14Martin Stjernholm  } }
08261e2008-08-24Stephen R. van den Berg  return;
13670c2015-05-25Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_ARRAY: {
10c6632009-02-06Stephen R. van den Berg  int i, alen;
19961b2017-04-08Martin Nilsson  struct array *a = Pike_sp[-1].u.array;
6898c02003-11-14Martin Stjernholm  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;
ff2bc92018-02-15Martin Nilsson  /* FALLTHRU */
e956bb2008-07-11Martin Stjernholm  case 1: if ((unsigned INT32) val <= 0xffff) break;
6898c02003-11-14Martin Stjernholm  shift = 2;
ff2bc92018-02-15Martin Nilsson  /* FALLTHRU */
e956bb2008-07-11Martin Stjernholm  case 2: #if SIZEOF_INT_TYPE > 4 if (val < MIN_INT32 || val > MAX_INT32)
3686232014-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:
19961b2017-04-08Martin Nilsson  Pike_error("Cannot cast %s to string.\n", get_name_of_type(TYPEOF(Pike_sp[-1])));
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
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];
19961b2017-04-08Martin Nilsson  format_pike_float (buf, Pike_sp[-1].u.float_number);
1d37212010-02-23Stephen R. van den Berg  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];
636bc52014-11-01Martin Nilsson  char *b = buf+sizeof buf-1; unsigned INT_TYPE i;
19961b2017-04-08Martin Nilsson  org = Pike_sp[-1].u.integer;
1d37212010-02-23Stephen R. van den Berg  *b-- = '\0'; i = org;
13670c2015-05-25Martin Nilsson 
1d37212010-02-23Stephen R. van den Berg  if( org < 0 ) i = -i;
13670c2015-05-25Martin Nilsson 
1d37212010-02-23Stephen R. van den Berg  goto jin; /* C as a macro assembler :-) */ do { i /= 10; jin: *b-- = '0'+(i%10); } while( i >= 10 );
13670c2015-05-25Martin Nilsson 
1d37212010-02-23Stephen R. van den Berg  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 
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_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 {
19961b2017-04-08Martin Nilsson  if(run_time_type != TYPEOF(Pike_sp[-1]))
6898c02003-11-14Martin Stjernholm  { if(run_time_type == T_MIXED) return;
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[-1]) == T_OBJECT && !Pike_sp[-1].u.object->prog) {
ef8a142004-09-20Martin Stjernholm  /* Casting a destructed object should be like casting a zero. */ pop_stack(); push_int (0); }
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) == T_OBJECT)
6898c02003-11-14Martin Stjernholm  {
19961b2017-04-08Martin Nilsson  struct object *o = Pike_sp[-1].u.object; int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(Pike_sp[-1])].prog, LFUN_CAST);
6e5a752012-10-27Henrik Grubbström (Grubba)  if(f == -1) {
3f30752016-01-11Martin Nilsson  if (run_time_type == T_MAPPING) { stack_dup(); f_indices(1); stack_swap(); f_values(1); f_mkmapping(2); goto emulated_type_ok; }
6e5a752012-10-27Henrik Grubbström (Grubba)  if (run_time_type != T_PROGRAM) { Pike_error("No cast method in object.\n"); } f_object_program(1); return; }
5e9fc02015-08-18Per Hedbor  push_static_text(get_name_of_type(type->type));
af40e42004-09-20Henrik Grubbström (Grubba)  apply_low(o, f, 1);
6e5a752012-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();
6e5a752012-10-27Henrik Grubbström (Grubba) 
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) == T_INT && SUBTYPEOF(Pike_sp[-1]) == NUMBER_UNDEFINED)
71e54e2014-08-18Martin Nilsson  Pike_error("Cannot cast this object to %s.\n", get_name_of_type(type->type));
6e5a752012-10-27Henrik Grubbström (Grubba)  } else
6898c02003-11-14Martin Stjernholm 
6b336f2015-05-01Martin Nilsson  switch(run_time_type) {
6898c02003-11-14Martin Stjernholm  default: Pike_error("Cannot perform cast to that type.\n");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
6898c02003-11-14Martin Stjernholm  case T_MULTISET:
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
6898c02003-11-14Martin Stjernholm  {
6b336f2015-05-01Martin Nilsson  case T_ARRAY:
6898c02003-11-14Martin Stjernholm  { f_mkmultiset(1); break; }
6b336f2015-05-01Martin Nilsson  default: Pike_error("Cannot cast %s to multiset.\n",
19961b2017-04-08Martin Nilsson  get_name_of_type(TYPEOF(Pike_sp[-1])));
6898c02003-11-14Martin Stjernholm  } break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_MAPPING:
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
6898c02003-11-14Martin Stjernholm  {
6b336f2015-05-01Martin Nilsson  case T_ARRAY:
6898c02003-11-14Martin Stjernholm  {
19961b2017-04-08Martin Nilsson  struct array *a=Pike_sp[-1].u.array;
6b336f2015-05-01Martin Nilsson  struct array *b; struct mapping *m; INT32 i; m=allocate_mapping(a->size); /* MAP_SLOTS(a->size) */ push_mapping(m); for (i=0; i<a->size; i++) { if (TYPEOF(ITEM(a)[i]) != T_ARRAY) Pike_error("Cast array to mapping: " "element %d is not an array\n", i); b=ITEM(a)[i].u.array; if (b->size!=2) Pike_error("Cast array to mapping: " "element %d is not an array of size 2\n", i); mapping_insert(m,ITEM(b)+0,ITEM(b)+1); } stack_swap(); pop_n_elems(1); break;
6898c02003-11-14Martin Stjernholm  }
6b336f2015-05-01Martin Nilsson  default: Pike_error("Cannot cast %s to mapping.\n",
19961b2017-04-08Martin Nilsson  get_name_of_type(TYPEOF(Pike_sp[-1])));
6898c02003-11-14Martin Stjernholm  } break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_ARRAY:
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
6898c02003-11-14Martin Stjernholm  {
6b336f2015-05-01Martin Nilsson  case T_MAPPING:
6898c02003-11-14Martin Stjernholm  {
19961b2017-04-08Martin Nilsson  struct array *a=mapping_to_array(Pike_sp[-1].u.mapping);
6898c02003-11-14Martin Stjernholm  pop_stack(); push_array(a); break; }
6b336f2015-05-01Martin Nilsson  case T_STRING: f_values(1); break;
6898c02003-11-14Martin Stjernholm 
6b336f2015-05-01Martin Nilsson  case T_MULTISET: f_indices(1); break;
6898c02003-11-14Martin Stjernholm 
6b336f2015-05-01Martin Nilsson  default: Pike_error("Cannot cast %s to array.\n",
19961b2017-04-08Martin Nilsson  get_name_of_type(TYPEOF(Pike_sp[-1])));
6898c02003-11-14Martin Stjernholm  } break;
6b336f2015-05-01Martin Nilsson  case T_INT: o_cast_to_int(); return; case T_STRING: o_cast_to_string(); return;
6898c02003-11-14Martin Stjernholm  case T_FLOAT:
6b336f2015-05-01Martin Nilsson  { FLOAT_TYPE f = 0.0;
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
6b336f2015-05-01Martin Nilsson  {
6898c02003-11-14Martin Stjernholm  case T_INT:
19961b2017-04-08Martin Nilsson  f=(FLOAT_TYPE)(Pike_sp[-1].u.integer);
6898c02003-11-14Martin Stjernholm  break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_STRING:
9e10fe2020-06-06Marcus Comstedt #if SIZEOF_FLOAT_TYPE > SIZEOF_DOUBLE f = (FLOAT_TYPE)STRTOLD_PCHARP(MKPCHARP(Pike_sp[-1].u.string->str, Pike_sp[-1].u.string->size_shift), 0); #else
6898c02003-11-14Martin Stjernholm  f =
19961b2017-04-08Martin Nilsson  (FLOAT_TYPE)STRTOD_PCHARP(MKPCHARP(Pike_sp[-1].u.string->str, Pike_sp[-1].u.string->size_shift),
6898c02003-11-14Martin Stjernholm  0);
9e10fe2020-06-06Marcus Comstedt #endif
19961b2017-04-08Martin Nilsson  free_string(Pike_sp[-1].u.string);
6898c02003-11-14Martin Stjernholm  break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  default:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to float.\n",
19961b2017-04-08Martin Nilsson  get_name_of_type(TYPEOF(Pike_sp[-1])));
6b336f2015-05-01Martin Nilsson  }
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_FLOAT, 0, float_number, f);
6b336f2015-05-01Martin Nilsson  break; }
6898c02003-11-14Martin Stjernholm  case T_OBJECT:
2a74cb2018-03-25Henrik Grubbström (Grubba)  { struct program *p = program_from_type(type); if (p) { struct svalue s; SET_SVAL(s, T_PROGRAM, 0, program, p); apply_svalue(&s, 1); return; } }
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
6898c02003-11-14Martin Stjernholm  {
6b336f2015-05-01Martin Nilsson  case T_STRING: { struct pike_string *file; INT_TYPE lineno; if(Pike_fp->pc &&
f14ace2019-02-02Henrik Grubbström (Grubba)  (file = low_get_line(Pike_fp->pc, Pike_fp->context->prog, &lineno, NULL))) {
6b336f2015-05-01Martin Nilsson  push_string(file); }else{ push_int(0); } /* FIXME: Ought to allow compile_handler to override. */ APPLY_MASTER("cast_to_object",2); return; } case T_FUNCTION: if (SUBTYPEOF(Pike_sp[-1]) == FUNCTION_BUILTIN) { Pike_error("Cannot cast builtin functions to object.\n"); } else if (Pike_sp[-1].u.object->prog == pike_trampoline_program) { ref_push_object(((struct pike_trampoline *) (Pike_sp[-1].u.object->storage))-> frame->current_object); stack_pop_keep_top(); } else { SET_SVAL_TYPE(Pike_sp[-1], T_OBJECT); SET_SVAL_SUBTYPE(Pike_sp[-1], 0); } break; default: Pike_error("Cannot cast %s to object.\n",
19961b2017-04-08Martin Nilsson  get_name_of_type(TYPEOF(Pike_sp[-1])));
6898c02003-11-14Martin Stjernholm  } break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_PROGRAM:
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
6b336f2015-05-01Martin Nilsson  {
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 &&
f14ace2019-02-02Henrik Grubbström (Grubba)  (file = low_get_line(Pike_fp->pc, Pike_fp->context->prog, &lineno, NULL))) {
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; }
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_FUNCTION:
6b336f2015-05-01Martin Nilsson  {
19961b2017-04-08Martin Nilsson  struct program *p=program_from_function(Pike_sp-1);
6b336f2015-05-01Martin Nilsson  if(p) { add_ref(p); pop_stack(); push_program(p); }else{ pop_stack(); push_int(0); } } return;
6898c02003-11-14Martin Stjernholm 
fe46a52014-02-26Henrik Grubbström (Grubba)  case PIKE_T_TYPE:
6b336f2015-05-01Martin Nilsson  { 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; }
fe46a52014-02-26Henrik Grubbström (Grubba) 
6898c02003-11-14Martin Stjernholm  default:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to a program.\n",
19961b2017-04-08Martin Nilsson  get_name_of_type(TYPEOF(Pike_sp[-1])));
6b336f2015-05-01Martin Nilsson  }
6898c02003-11-14Martin Stjernholm  } }
19961b2017-04-08Martin Nilsson  if(run_time_type != TYPEOF(Pike_sp[-1]))
6898c02003-11-14Martin Stjernholm  {
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1])) {
6e5a752012-10-27Henrik Grubbström (Grubba)  case T_OBJECT:
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.object->prog)
6898c02003-11-14Martin Stjernholm  {
19961b2017-04-08Martin Nilsson  struct object *o = Pike_sp[-1].u.object; int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(Pike_sp[-1])].prog,
6e5a752012-10-27Henrik Grubbström (Grubba)  LFUN__IS_TYPE); if( f != -1) {
5e9fc02015-08-18Per Hedbor  push_static_text(get_name_of_type(run_time_type));
6e5a752012-10-27Henrik Grubbström (Grubba)  apply_low(o, f, 1);
19961b2017-04-08Martin Nilsson  f=!UNSAFE_IS_ZERO(Pike_sp-1);
6e5a752012-10-27Henrik Grubbström (Grubba)  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) &&
19961b2017-04-08Martin Nilsson  program_from_function(Pike_sp-1)) {
6e5a752012-10-27Henrik Grubbström (Grubba)  return; /* No need for further post-processing. */
6898c02003-11-14Martin Stjernholm  }
6e5a752012-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),
19961b2017-04-08Martin Nilsson  get_name_of_type(TYPEOF(Pike_sp[-1])));
6898c02003-11-14Martin Stjernholm  }
6b336f2015-05-01Martin Nilsson  emulated_type_ok:
6898c02003-11-14Martin Stjernholm  if (!type) return; switch(run_time_type) {
6b336f2015-05-01Martin Nilsson  case T_ARRAY:
6898c02003-11-14Martin Stjernholm  { 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;
19961b2017-04-08Martin Nilsson  struct array *tmp=Pike_sp[-2].u.array;
6898c02003-11-14Martin Stjernholm  DECLARE_CYCLIC();
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  if((a=(struct array *)BEGIN_CYCLIC(tmp,0))) { ref_push_array(a); }else{ INT32 e; TYPE_FIELD types = 0; #ifdef PIKE_DEBUG
19961b2017-04-08Martin Nilsson  struct svalue *save_sp=Pike_sp+1;
6898c02003-11-14Martin Stjernholm #endif push_array(a=allocate_array(tmp->size)); SET_CYCLIC_RET(a);
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  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
19961b2017-04-08Martin Nilsson  if(save_sp!=Pike_sp)
6898c02003-11-14Martin Stjernholm  Pike_fatal("o_cast left stack droppings.\n"); #endif } END_CYCLIC();
19961b2017-04-08Martin Nilsson  assign_svalue(Pike_sp-3,Pike_sp-1);
6898c02003-11-14Martin Stjernholm  pop_stack(); } pop_stack(); } break;
6b336f2015-05-01Martin Nilsson  case T_MULTISET:
6898c02003-11-14Martin Stjernholm  { 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;
19961b2017-04-08Martin Nilsson  struct multiset *tmp=Pike_sp[-2].u.multiset;
6898c02003-11-14Martin Stjernholm  DECLARE_CYCLIC();
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  if((m=(struct multiset *)BEGIN_CYCLIC(tmp,0))) { ref_push_multiset(m); }else{ #ifdef PIKE_DEBUG
19961b2017-04-08Martin Nilsson  struct svalue *save_sp=Pike_sp+1;
6898c02003-11-14Martin Stjernholm #endif ptrdiff_t nodepos; 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);
19961b2017-04-08Martin Nilsson  multiset_insert (m, Pike_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
19961b2017-04-08Martin Nilsson  if(save_sp!=Pike_sp)
6898c02003-11-14Martin Stjernholm  Pike_fatal("o_cast left stack droppings.\n"); #endif } END_CYCLIC();
19961b2017-04-08Martin Nilsson  assign_svalue(Pike_sp-3,Pike_sp-1);
6898c02003-11-14Martin Stjernholm  pop_stack(); } pop_stack(); } break;
6b336f2015-05-01Martin Nilsson  case T_MAPPING:
6898c02003-11-14Martin Stjernholm  { 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;
19961b2017-04-08Martin Nilsson  struct mapping *tmp=Pike_sp[-3].u.mapping;
6898c02003-11-14Martin Stjernholm  DECLARE_CYCLIC();
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  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
19961b2017-04-08Martin Nilsson  struct svalue *save_sp=Pike_sp+1;
6898c02003-11-14Martin Stjernholm #endif push_mapping(m=allocate_mapping(m_sizeof(tmp)));
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  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);
19961b2017-04-08Martin Nilsson  mapping_insert(m,Pike_sp-2,Pike_sp-1);
6898c02003-11-14Martin Stjernholm  pop_n_elems(2); } #ifdef PIKE_DEBUG
19961b2017-04-08Martin Nilsson  if(save_sp!=Pike_sp)
6898c02003-11-14Martin Stjernholm  Pike_fatal("o_cast left stack droppings.\n"); #endif } END_CYCLIC();
19961b2017-04-08Martin Nilsson  assign_svalue(Pike_sp-4,Pike_sp-1);
6898c02003-11-14Martin Stjernholm  pop_stack(); } pop_n_elems(2); } } } PMOD_EXPORT void f_cast(void) { #ifdef PIKE_DEBUG
19961b2017-04-08Martin Nilsson  struct svalue *save_sp=Pike_sp; if(TYPEOF(Pike_sp[-2]) != T_TYPE)
6898c02003-11-14Martin Stjernholm  Pike_fatal("Cast expression destroyed stack or left droppings! (Type:%d)\n",
19961b2017-04-08Martin Nilsson  TYPEOF(Pike_sp[-2]));
6898c02003-11-14Martin Stjernholm #endif
19961b2017-04-08Martin Nilsson  o_cast(Pike_sp[-2].u.type, compile_type_to_runtime_type(Pike_sp[-2].u.type));
6898c02003-11-14Martin Stjernholm #ifdef PIKE_DEBUG
19961b2017-04-08Martin Nilsson  if(save_sp != Pike_sp)
6898c02003-11-14Martin Stjernholm  Pike_fatal("Internal error: o_cast() left droppings on stack.\n"); #endif
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp-2); Pike_sp[-2]=Pike_sp[-1]; Pike_sp--; dmalloc_touch_svalue(Pike_sp);
6898c02003-11-14Martin Stjernholm }
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;
5f50842018-02-12Marcus Comstedt  /* FALLTHRU */
b5955a2006-08-21Henrik Grubbström (Grubba)  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:
b5955a2006-08-21Henrik Grubbström (Grubba)  type = type->cdr; goto loop;
c497ac2018-05-31Henrik Grubbström (Grubba)  case PIKE_T_ATTRIBUTE: { int ret; if (!low_check_soft_cast(s, type->cdr)) return 0; push_svalue(s); ref_push_string((struct pike_string *)type->car); SAFE_MAYBE_APPLY_MASTER("handle_attribute", 2); ret = !SAFE_IS_ZERO(Pike_sp-1) || IS_UNDEFINED(Pike_sp-1); pop_stack(); return ret; }
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) {
47e1812013-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;
47e1812013-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;
5e9fc02015-08-18Per Hedbor  push_static_text(get_name_of_type(type->type));
b5955a2006-08-21Henrik Grubbström (Grubba)  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; }
13670c2015-05-25Martin Nilsson 
b5955a2006-08-21Henrik Grubbström (Grubba)  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;
4d404a2013-02-19Henrik Grubbström (Grubba)  struct string_builder s;
b5955a2006-08-21Henrik Grubbström (Grubba)  char *fname = "__soft-cast";
4d404a2013-02-19Henrik Grubbström (Grubba)  ONERROR tmp0;
b5955a2006-08-21Henrik Grubbström (Grubba)  ONERROR tmp1;
4d404a2013-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);
13670c2015-05-25Martin Nilsson 
b5955a2006-08-21Henrik Grubbström (Grubba)  free_type(sval_type);
212c392018-02-25Martin Nilsson  bad_arg_error(NULL, -1, 1, t1->str, Pike_sp-1,
4d404a2013-02-19Henrik Grubbström (Grubba)  "%s(): Soft cast failed.\n%S", fname, s.s);
9282fd2015-09-27Martin Nilsson  UNREACHABLE(CALL_AND_UNSET_ONERROR(tmp1)); UNREACHABLE(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: \
06bd612016-01-26Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR(NAME, 2); \
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  case 2: \
19961b2017-04-08Martin Nilsson  i=FUN (Pike_sp-2,Pike_sp-1); \
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  pop_n_elems(2); \ push_int(i); \ break; \ default: \ for(i=1;i<args;i++) \
19961b2017-04-08Martin Nilsson  if(! ( FUN (Pike_sp-args+i-1, Pike_sp-args+i))) \
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  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);
18678b2016-12-30Martin Nilsson  /* f_eq and friends always returns 1 or 0. */ Pike_sp[-1].u.integer = !Pike_sp[-1].u.integer;
5b4dd31998-02-23Fredrik Hübinette (Hubbe) }
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
10789d2014-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) 
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; } }
4799eb2017-01-03Martin Nilsson static void add_strings(INT32 args) { struct pike_string *r; PCHARP buf; ptrdiff_t tmp; int max_shift=0; ptrdiff_t size=0,e; int num=0; for(e=-args;e<0;e++) {
19961b2017-04-08Martin Nilsson  if(Pike_sp[e].u.string->len != 0) num++; size += Pike_sp[e].u.string->len; if(Pike_sp[e].u.string->size_shift > max_shift) max_shift=Pike_sp[e].u.string->size_shift;
4799eb2017-01-03Martin Nilsson  } /* All strings are empty. */ if(num == 0) { pop_n_elems(args-1); return; } /* Only one string has length. */ if(num == 1) { for(e=-args;e<0;e++) {
19961b2017-04-08Martin Nilsson  if( Pike_sp[e].u.string->len )
4799eb2017-01-03Martin Nilsson  { if( e != -args ) {
19961b2017-04-08Martin Nilsson  r = Pike_sp[e].u.string; Pike_sp[e].u.string = Pike_sp[-args].u.string; Pike_sp[-args].u.string = r;
4799eb2017-01-03Martin Nilsson  } } } pop_n_elems(args-1); return; }
19961b2017-04-08Martin Nilsson  tmp=Pike_sp[-args].u.string->len; r=new_realloc_shared_string(Pike_sp[-args].u.string,size,max_shift); mark_free_svalue (Pike_sp - args);
4799eb2017-01-03Martin Nilsson  buf=MKPCHARP_STR_OFF(r,tmp); for(e=-args+1;e<0;e++) {
19961b2017-04-08Martin Nilsson  if( Pike_sp[e].u.string->len )
4799eb2017-01-03Martin Nilsson  {
19961b2017-04-08Martin Nilsson  update_flags_for_add( r, Pike_sp[e].u.string ); pike_string_cpy(buf,Pike_sp[e].u.string); INC_PCHARP(buf,Pike_sp[e].u.string->len);
4799eb2017-01-03Martin Nilsson  }
979dc52017-06-20Henrik Grubbström (Grubba)  free_string(Pike_sp[e].u.string);
4799eb2017-01-03Martin Nilsson  } Pike_sp -= args-1;
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_STRING, 0, string, low_end_shared_string(r));
4799eb2017-01-03Martin Nilsson }
c17a082017-01-02Martin Nilsson static int pair_add() {
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) == PIKE_T_OBJECT || TYPEOF(Pike_sp[-2]) == PIKE_T_OBJECT)
c17a082017-01-02Martin Nilsson  {
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-2]) == PIKE_T_OBJECT &&
c17a082017-01-02Martin Nilsson  /* Note: pairwise add always has an extra reference! */
19961b2017-04-08Martin Nilsson  Pike_sp[-2].u.object->refs == 2 &&
c17a082017-01-02Martin Nilsson  call_lhs_lfun(LFUN_ADD_EQ,2)) return 1; /* optimized version of +. */ if(call_lfun(LFUN_ADD, LFUN_RADD))
19961b2017-04-08Martin Nilsson  return !IS_UNDEFINED(Pike_sp-1);
c17a082017-01-02Martin Nilsson  }
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[-2]) != TYPEOF(Pike_sp[-1]))
c17a082017-01-02Martin Nilsson  {
19961b2017-04-08Martin Nilsson  if(IS_UNDEFINED(Pike_sp-2))
c17a082017-01-02Martin Nilsson  { stack_swap(); pop_stack(); return 1; }
19961b2017-04-08Martin Nilsson  if(IS_UNDEFINED(Pike_sp-1))
c17a082017-01-02Martin Nilsson  { pop_stack(); return 1; } /* string + X && X + string -> string */ if( TYPEOF(Pike_sp[-2]) == PIKE_T_STRING ) o_cast_to_string(); else if( TYPEOF(Pike_sp[-1]) == PIKE_T_STRING ) { stack_swap(); o_cast_to_string(); stack_swap(); } else if( TYPEOF(Pike_sp[-2]) == PIKE_T_FLOAT ) { if( TYPEOF(Pike_sp[-1]) == PIKE_T_INT ) { Pike_sp[-1].u.float_number = Pike_sp[-1].u.integer; TYPEOF(Pike_sp[-1]) = PIKE_T_FLOAT; } } else if( TYPEOF(Pike_sp[-1]) == PIKE_T_FLOAT ) { if( TYPEOF(Pike_sp[-2]) == PIKE_T_INT ) { Pike_sp[-2].u.float_number = Pike_sp[-2].u.integer; TYPEOF(Pike_sp[-2]) = PIKE_T_FLOAT; } }
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[-2]) != TYPEOF(Pike_sp[-1]))
c17a082017-01-02Martin Nilsson  return 0; } /* types now identical. */
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
c17a082017-01-02Martin Nilsson  { /* Note: these cases mainly tend to happen when there is an object in the argument list. otherwise pairwise addition is not done using this code. */ case PIKE_T_INT: { INT_TYPE res;
19961b2017-04-08Martin Nilsson  if (DO_INT_TYPE_ADD_OVERFLOW(Pike_sp[-2].u.integer, Pike_sp[-1].u.integer, &res))
c17a082017-01-02Martin Nilsson  {
19961b2017-04-08Martin Nilsson  convert_svalue_to_bignum(Pike_sp-2);
b0f5282019-08-09Henrik Grubbström (Grubba)  if (LIKELY(call_lfun(LFUN_ADD,LFUN_RADD))) { return 1; } Pike_fatal("Failed to call `+() in bignum.\n");
c17a082017-01-02Martin Nilsson  }
19961b2017-04-08Martin Nilsson  Pike_sp[-2].u.integer = res; Pike_sp--;
c17a082017-01-02Martin Nilsson  } return 1; case PIKE_T_FLOAT:
19961b2017-04-08Martin Nilsson  Pike_sp[-2].u.float_number += Pike_sp[-1].u.float_number; Pike_sp--;
c17a082017-01-02Martin Nilsson  return 1; case PIKE_T_STRING: Pike_sp[-2].u.string = add_and_free_shared_strings(Pike_sp[-2].u.string, Pike_sp[-1].u.string); Pike_sp--; return 1; case PIKE_T_ARRAY:
19961b2017-04-08Martin Nilsson  push_array( add_arrays(Pike_sp-2,2) );
c17a082017-01-02Martin Nilsson  stack_swap(); pop_stack(); stack_swap(); pop_stack(); return 1; case PIKE_T_MAPPING:
19961b2017-04-08Martin Nilsson  push_mapping( add_mappings(Pike_sp-2,2) );
c17a082017-01-02Martin Nilsson  stack_swap(); pop_stack(); stack_swap(); pop_stack(); return 1; case PIKE_T_MULTISET:
19961b2017-04-08Martin Nilsson  push_multiset( add_multisets(Pike_sp-2,2) );
c17a082017-01-02Martin Nilsson  stack_swap(); pop_stack(); stack_swap(); pop_stack(); return 1; case PIKE_T_OBJECT: return call_lfun(LFUN_ADD,LFUN_RADD); } return 0; }
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) {
3bcf052017-01-03Martin Nilsson  INT_TYPE e;
4799eb2017-01-03Martin Nilsson  TYPE_FIELD types=0;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
c17a082017-01-02Martin Nilsson  if(!args) SIMPLE_WRONG_NUM_ARGS_ERROR("`+", 1);
08b3ec2011-04-08Henrik Grubbström (Grubba)  if (args == 1) return;
19961b2017-04-08Martin Nilsson  for(e=-args;e<0;e++) types |= 1<<TYPEOF(Pike_sp[e]);
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  switch(types) { default:
4799eb2017-01-03Martin Nilsson  pairwise_add:
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
19961b2017-04-08Martin Nilsson  struct svalue *s=Pike_sp-args;
4799eb2017-01-03Martin Nilsson  push_svalue(s); for(e=1;e<args;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
4799eb2017-01-03Martin Nilsson  push_svalue(s+e); if(!pair_add()) { Pike_error("Addition on unsupported types: %s + %s\nm",
4448432017-01-04Martin Nilsson  get_name_of_type(TYPEOF(*(s+e))),
4799eb2017-01-03Martin Nilsson  get_name_of_type(TYPEOF(*s))); }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
19961b2017-04-08Martin Nilsson  assign_svalue(s,Pike_sp-1); pop_n_elems(Pike_sp-s-1);
66769e1999-11-04Fredrik Hübinette (Hubbe)  return; }
9925512013-05-31Per Hedbor 
4799eb2017-01-03Martin Nilsson  case BIT_STRING: add_strings(args); return;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case BIT_STRING | BIT_INT: case BIT_STRING | BIT_FLOAT: case BIT_STRING | BIT_FLOAT | BIT_INT:
19961b2017-04-08Martin Nilsson  if ((TYPEOF(Pike_sp[-args]) != T_STRING) && (TYPEOF(Pike_sp[1-args]) != T_STRING))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
4799eb2017-01-03Martin Nilsson  /* Note: Could easily use pairwise add until at first string. */ goto pairwise_add;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } for(e=-args;e<0;e++) {
19961b2017-04-08Martin Nilsson  if( TYPEOF(Pike_sp[e]) != PIKE_T_STRING )
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
19961b2017-04-08Martin Nilsson  *Pike_sp = Pike_sp[e];
4799eb2017-01-03Martin Nilsson  Pike_sp++;
19961b2017-04-08Martin Nilsson  o_cast_to_string(); /* free:s old Pike_sp[e] */ Pike_sp[e-1] = Pike_sp[-1];
4799eb2017-01-03Martin Nilsson  Pike_sp--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
4799eb2017-01-03Martin Nilsson  add_strings(args); return;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case BIT_INT:
f306632012-12-31Arne Goedeke  {
19961b2017-04-08Martin Nilsson  INT_TYPE size = Pike_sp[-args].u.integer;
3bcf052017-01-03Martin Nilsson  for(e = -args+1; e < 0; e++)
fda0de1999-10-08Fredrik Noring  {
19961b2017-04-08Martin Nilsson  if (DO_INT_TYPE_ADD_OVERFLOW(size, Pike_sp[e].u.integer, &size))
fe62692014-01-11Arne Goedeke  {
19961b2017-04-08Martin Nilsson  convert_svalue_to_bignum(Pike_sp-args);
fe62692014-01-11Arne Goedeke  f_add(args); return; }
fda0de1999-10-08Fredrik Noring  }
19961b2017-04-08Martin Nilsson  Pike_sp-=args;
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  push_int(size);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
f306632012-12-31Arne Goedeke  }
3bcf052017-01-03Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case BIT_FLOAT:
f750692017-01-01Martin Nilsson  {
9e10fe2020-06-06Marcus Comstedt  FLOAT_ARG_TYPE res = Pike_sp[-args].u.float_number;
f750692017-01-01Martin Nilsson  for(e=args-1; e>0; e-- )
19961b2017-04-08Martin Nilsson  res += Pike_sp[-e].u.float_number;
f750692017-01-01Martin Nilsson  Pike_sp -= args-1; Pike_sp[-1].u.float_number = res;
08b3ec2011-04-08Henrik Grubbström (Grubba)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
482fb51999-03-12Per Hedbor  case BIT_FLOAT|BIT_INT:
bce86c1996-02-25Fredrik Hübinette (Hubbe)  {
9e10fe2020-06-06Marcus Comstedt  FLOAT_ARG_TYPE res = 0.0;
56c5402017-04-14Henrik Grubbström (Grubba)  int i; for(i=0; i<args; i++)
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[i-args]) == T_FLOAT)
f750692017-01-01Martin Nilsson  res += Pike_sp[i-args].u.float_number; else
9e10fe2020-06-06Marcus Comstedt  res += (FLOAT_ARG_TYPE)Pike_sp[i-args].u.integer;
f750692017-01-01Martin Nilsson  Pike_sp-=args; push_float(res); return;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  }
09cae22003-11-12Martin Stjernholm #define ADD(TYPE, ADD_FUNC, PUSH_FUNC) do { \
19961b2017-04-08Martin Nilsson  struct TYPE *x = ADD_FUNC (Pike_sp - args, args); \
09cae22003-11-12Martin Stjernholm  pop_n_elems (args); \ PUSH_FUNC (x); \ return; \ } while (0)
3bcf052017-01-03Martin Nilsson #define REMOVE_UNDEFINED(TYPE) \ do { \ int to = -args, i=-args; \ for(; i<0; i++) \ { \ if(TYPEOF(Pike_sp[i]) == PIKE_T_INT) \ { \ if(!IS_UNDEFINED(Pike_sp+i)) \ SIMPLE_ARG_TYPE_ERROR("`+", args+i, #TYPE); \ } \ else if(to!=i) \ Pike_sp[to++] = Pike_sp[i]; \ else to++; \ } \
56c5402017-04-14Henrik Grubbström (Grubba)  for(i=to; i<0; i++) \
3bcf052017-01-03Martin Nilsson  TYPEOF(Pike_sp[i])=PIKE_T_INT; \ Pike_sp += to; \ args += to; \ } while(0);
13670c2015-05-25Martin Nilsson 
3bcf052017-01-03Martin Nilsson  case BIT_ARRAY|BIT_INT: REMOVE_UNDEFINED (array); /* Fallthrough */
5267b71995-08-09Fredrik Hübinette (Hubbe)  case BIT_ARRAY:
09cae22003-11-12Martin Stjernholm  ADD (array, add_arrays, push_array);
7c15fa2015-04-22Henrik Grubbström (Grubba)  break;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
482fb51999-03-12Per Hedbor  case BIT_MAPPING|BIT_INT:
3bcf052017-01-03Martin Nilsson  REMOVE_UNDEFINED (mapping); /* Fallthrough */
5267b71995-08-09Fredrik Hübinette (Hubbe)  case BIT_MAPPING:
09cae22003-11-12Martin Stjernholm  ADD (mapping, add_mappings, push_mapping);
7c15fa2015-04-22Henrik Grubbström (Grubba)  break;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
09cae22003-11-12Martin Stjernholm  case BIT_MULTISET|BIT_INT:
3bcf052017-01-03Martin Nilsson  REMOVE_UNDEFINED (multiset); /* Fallthrough */
06983f1996-09-22Fredrik Hübinette (Hubbe)  case BIT_MULTISET:
09cae22003-11-12Martin Stjernholm  ADD (multiset, add_multisets, push_multiset);
7c15fa2015-04-22Henrik Grubbström (Grubba)  break;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
3bcf052017-01-03Martin Nilsson #undef REMOVE_UNDEFINED
09cae22003-11-12Martin Stjernholm #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);
13670c2015-05-25Martin Nilsson 
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);
13670c2015-05-25Martin Nilsson 
204a5a2004-08-24Henrik Grubbström (Grubba)  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);
13670c2015-05-25Martin Nilsson 
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; }
13670c2015-05-25Martin Nilsson 
6930181996-02-25Fredrik Hübinette (Hubbe)  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);
664cad2020-01-23Henrik Grubbström (Grubba)  push_unlimited_array_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) {
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-2]) == T_INT && TYPEOF(Pike_sp[-1]) == T_FLOAT)
bce86c1996-02-25Fredrik Hübinette (Hubbe)  {
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-2], T_FLOAT, 0, float_number, (FLOAT_TYPE)Pike_sp[-2].u.integer);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 1;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  }
19961b2017-04-08Martin Nilsson  else if(TYPEOF(Pike_sp[-1]) == T_INT && TYPEOF(Pike_sp[-2]) == T_FLOAT)
bce86c1996-02-25Fredrik Hübinette (Hubbe)  {
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_FLOAT, 0, float_number, (FLOAT_TYPE)Pike_sp[-1].u.integer);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 1; }
e924491999-12-14Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  if(is_bignum_object_in_svalue(Pike_sp-2) && TYPEOF(Pike_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; }
19961b2017-04-08Martin Nilsson  else if(is_bignum_object_in_svalue(Pike_sp-1) && TYPEOF(Pike_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; }
0311712013-06-17Martin Nilsson 
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 0; }
b83b372016-12-31Martin Nilsson static int has_lfun(enum LFUN lfun, int arg) { struct program *p;
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-arg]) == T_OBJECT && (p = Pike_sp[-arg].u.object->prog)) return FIND_LFUN(p->inherits[SUBTYPEOF(Pike_sp[-arg])].prog, lfun);
b83b372016-12-31Martin Nilsson  return -1; } static int call_lhs_lfun( enum LFUN lfun, int arg ) {
efd3792016-12-31Martin Nilsson  int i = has_lfun(lfun,arg);
b83b372016-12-31Martin Nilsson 
efd3792016-12-31Martin Nilsson  if(i != -1) { apply_low(Pike_sp[-arg].u.object, i, arg-1); return 1; }
b83b372016-12-31Martin Nilsson  return 0; }
18678b2016-12-30Martin Nilsson static int call_lfun(enum LFUN left, enum LFUN right)
1b89ad1997-10-10Fredrik Hübinette (Hubbe) {
9793b72004-12-18Henrik Grubbström (Grubba)  struct object *o; struct program *p;
33c9582003-11-10Martin Stjernholm  int i;
9793b72004-12-18Henrik Grubbström (Grubba) 
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-2]) == T_OBJECT && (p = (o = Pike_sp[-2].u.object)->prog) && (i = FIND_LFUN(p->inherits[SUBTYPEOF(Pike_sp[-2])].prog, left)) != -1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, 1);
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp-2); Pike_sp[-2]=Pike_sp[-1]; Pike_sp--; dmalloc_touch_svalue(Pike_sp);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 1;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  }
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) == T_OBJECT && (p = (o = Pike_sp[-1].u.object)->prog) && (i = FIND_LFUN(p->inherits[SUBTYPEOF(Pike_sp[-1])].prog, right)) != -1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
19961b2017-04-08Martin Nilsson  push_svalue(Pike_sp-2);
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, 1);
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp-3); Pike_sp[-3]=Pike_sp[-1]; Pike_sp--; dmalloc_touch_svalue(Pike_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) 
13670c2015-05-25Martin Nilsson struct mapping *merge_mapping_array_ordered(struct mapping *a,
aa17e32000-04-12Mirar (Pontus Hagland)  struct array *b, INT32 op);
13670c2015-05-25Martin Nilsson struct mapping *merge_mapping_array_unordered(struct mapping *a,
aa17e32000-04-12Mirar (Pontus Hagland)  struct array *b, INT32 op);
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_subtract(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[-2]) != TYPEOF(Pike_sp[-1]) && !float_promote())
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  { if(call_lfun(LFUN_SUBTRACT, LFUN_RSUBTRACT)) return;
aa17e32000-04-12Mirar (Pontus Hagland) 
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[-2]) == T_MAPPING) switch (TYPEOF(Pike_sp[-1]))
aa17e32000-04-12Mirar (Pontus Hagland)  { case T_ARRAY: { struct mapping *m;
19961b2017-04-08Martin Nilsson  m=merge_mapping_array_unordered(Pike_sp[-2].u.mapping, Pike_sp[-1].u.array,
aa17e32000-04-12Mirar (Pontus Hagland)  PIKE_ARRAY_OP_SUB); pop_n_elems(2); push_mapping(m); return; } case T_MULTISET: { struct mapping *m;
19961b2017-04-08Martin Nilsson  int got_cmp_less = !!multiset_get_cmp_less (Pike_sp[-1].u.multiset); struct array *ind = multiset_indices (Pike_sp[-1].u.multiset);
5b15bb2001-12-10Martin Stjernholm  pop_stack(); push_array (ind); if (got_cmp_less)
19961b2017-04-08Martin Nilsson  m=merge_mapping_array_unordered(Pike_sp[-2].u.mapping, Pike_sp[-1].u.array,
5b15bb2001-12-10Martin Stjernholm  PIKE_ARRAY_OP_SUB); else
19961b2017-04-08Martin Nilsson  m=merge_mapping_array_ordered(Pike_sp[-2].u.mapping, Pike_sp[-1].u.array,
5b15bb2001-12-10Martin Stjernholm  PIKE_ARRAY_OP_SUB);
aa17e32000-04-12Mirar (Pontus Hagland)  pop_n_elems(2); push_mapping(m); return; } }
212c392018-02-25Martin Nilsson  bad_arg_error("`-", 2, 2, get_name_of_type(TYPEOF(Pike_sp[-2])),
19961b2017-04-08Martin Nilsson  Pike_sp-1, "Subtract on different types.\n");
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
2a89252016-12-30Martin Nilsson  if(!call_lfun(LFUN_SUBTRACT, LFUN_RSUBTRACT))
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`-", "Subtract on objects without `- operator.\n", Pike_sp, 2);
2a89252016-12-30Martin Nilsson  return;
07c0731996-06-21Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_ARRAY: { struct array *a;
19961b2017-04-08Martin Nilsson  check_array_for_destruct(Pike_sp[-2].u.array); check_array_for_destruct(Pike_sp[-1].u.array); a = subtract_arrays(Pike_sp[-2].u.array, Pike_sp[-1].u.array);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_array(a); return; } case T_MAPPING: { struct mapping *m;
19961b2017-04-08Martin Nilsson  m=merge_mappings(Pike_sp[-2].u.mapping, Pike_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;
19961b2017-04-08Martin Nilsson  l=merge_multisets(Pike_sp[-2].u.multiset, Pike_sp[-1].u.multiset,
d05ad72016-12-30Martin Nilsson  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:
19961b2017-04-08Martin Nilsson  Pike_sp--; Pike_sp[-1].u.float_number -= Pike_sp[0].u.float_number;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; case T_INT:
19961b2017-04-08Martin Nilsson  if(INT_TYPE_SUB_OVERFLOW(Pike_sp[-2].u.integer, Pike_sp[-1].u.integer))
ff0d461999-10-15Fredrik Noring  { convert_stack_top_to_bignum();
b0f5282019-08-09Henrik Grubbström (Grubba)  if (LIKELY(call_lfun(LFUN_SUBTRACT, LFUN_RSUBTRACT))) { return; } Pike_fatal("Failed to call `-() in bignum.\n");
ff0d461999-10-15Fredrik Noring  }
19961b2017-04-08Martin Nilsson  Pike_sp--; SET_SVAL(Pike_sp[-1], PIKE_T_INT, NUMBER_NUMBER, integer, Pike_sp[-1].u.integer - Pike_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("");
19961b2017-04-08Martin Nilsson  ret=string_replace(Pike_sp[-2].u.string,Pike_sp[-1].u.string,s); free_string(Pike_sp[-2].u.string); free_string(Pike_sp[-1].u.string);
5267b71995-08-09Fredrik Hübinette (Hubbe)  free_string(s);
19961b2017-04-08Martin Nilsson  Pike_sp[-2].u.string=ret; Pike_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;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`-", 1,
54db6c1999-03-27Henrik Grubbström (Grubba)  "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
b912e92018-05-19Arne Goedeke  *! 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. *!
b912e92018-05-19Arne Goedeke  *! @note *! If this operator is used with arrays or multisets containing objects *! which implement @[lfun::`==()] but @b{not@} @[lfun::`>()] and *! @[lfun::`<()], the result will be undefined. *!
f09ec92001-02-07Henrik Grubbström (Grubba)  *! @seealso *! @[`+()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_minus(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
06bd612016-01-26Martin Nilsson  case 0: SIMPLE_WRONG_NUM_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;
19961b2017-04-08Martin Nilsson  struct svalue *s=Pike_sp-args;
8496b22011-04-09Henrik Grubbström (Grubba) 
19961b2017-04-08Martin Nilsson  for(e=-args;e<0;e++) types |= 1<<TYPEOF(Pike_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; }
13670c2015-05-25Martin Nilsson 
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  push_svalue(s); for(e=1;e<args;e++) { push_svalue(s+e); o_subtract(); }
19961b2017-04-08Martin Nilsson  assign_svalue(s,Pike_sp-1); pop_n_elems(Pike_sp-s-1);
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  }
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) {
19961b2017-04-08Martin Nilsson  if(UNLIKELY(TYPEOF(Pike_sp[-1]) != TYPEOF(Pike_sp[-2])))
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
13670c2015-05-25Martin Nilsson  if(call_lfun(LFUN_AND, LFUN_RAND))
aa17e32000-04-12Mirar (Pontus Hagland)  return;
19961b2017-04-08Martin Nilsson  else if (((TYPEOF(Pike_sp[-1]) == T_TYPE) || (TYPEOF(Pike_sp[-1]) == T_PROGRAM) || (TYPEOF(Pike_sp[-1]) == T_FUNCTION)) && ((TYPEOF(Pike_sp[-2]) == T_TYPE) || (TYPEOF(Pike_sp[-2]) == T_PROGRAM) || (TYPEOF(Pike_sp[-2]) == T_FUNCTION)))
aa17e32000-04-12Mirar (Pontus Hagland)  {
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[-2]) != T_TYPE)
aa17e32000-04-12Mirar (Pontus Hagland)  {
19961b2017-04-08Martin Nilsson  struct program *p = program_from_svalue(Pike_sp - 2);
aa17e32000-04-12Mirar (Pontus Hagland)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`&", 1, "type");
aa17e32000-04-12Mirar (Pontus Hagland)  } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp - 2); SET_SVAL(Pike_sp[-2], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[-1]) != T_TYPE)
aa17e32000-04-12Mirar (Pontus Hagland)  {
19961b2017-04-08Martin Nilsson  struct program *p = program_from_svalue(Pike_sp - 1);
13670c2015-05-25Martin Nilsson  if (!p)
aa17e32000-04-12Mirar (Pontus Hagland)  { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`&", 2, "type");
aa17e32000-04-12Mirar (Pontus Hagland)  } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp - 1); SET_SVAL(Pike_sp[-1], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
13670c2015-05-25Martin Nilsson  }
19961b2017-04-08Martin Nilsson  else if (TYPEOF(Pike_sp[-2]) == T_MAPPING) switch (TYPEOF(Pike_sp[-1]))
aa17e32000-04-12Mirar (Pontus Hagland)  { case T_ARRAY: { struct mapping *m;
19961b2017-04-08Martin Nilsson  m=merge_mapping_array_unordered(Pike_sp[-2].u.mapping, Pike_sp[-1].u.array,
aa17e32000-04-12Mirar (Pontus Hagland)  PIKE_ARRAY_OP_AND); pop_n_elems(2); push_mapping(m); return; } case T_MULTISET: { struct mapping *m;
19961b2017-04-08Martin Nilsson  int got_cmp_less = !!multiset_get_cmp_less (Pike_sp[-1].u.multiset); struct array *ind = multiset_indices (Pike_sp[-1].u.multiset);
5b15bb2001-12-10Martin Stjernholm  pop_stack(); push_array (ind); if (got_cmp_less)
19961b2017-04-08Martin Nilsson  m=merge_mapping_array_unordered(Pike_sp[-2].u.mapping, Pike_sp[-1].u.array,
5b15bb2001-12-10Martin Stjernholm  PIKE_ARRAY_OP_AND); else
19961b2017-04-08Martin Nilsson  m=merge_mapping_array_ordered(Pike_sp[-2].u.mapping, Pike_sp[-1].u.array,
5b15bb2001-12-10Martin Stjernholm  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;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`&", 2, "mapping");
eed2da2001-06-11Henrik Grubbström (Grubba)  }
aa17e32000-04-12Mirar (Pontus Hagland)  }
13670c2015-05-25Martin Nilsson  else
aa17e32000-04-12Mirar (Pontus Hagland)  { int args = 2;
19961b2017-04-08Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`&", 2, get_name_of_type(TYPEOF(Pike_sp[-2])));
aa17e32000-04-12Mirar (Pontus Hagland)  }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
4d42652016-12-31Martin Nilsson  if(!call_lfun(LFUN_AND,LFUN_RAND))
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`&", "Bitwise and on objects without `& operator.\n", Pike_sp, 2);
4d42652016-12-31Martin Nilsson  return;
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT:
19961b2017-04-08Martin Nilsson  Pike_sp--; SET_SVAL(Pike_sp[-1], PIKE_T_INT, NUMBER_NUMBER, integer, Pike_sp[-1].u.integer & Pike_sp[0].u.integer);
4d42652016-12-31Martin Nilsson  return;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_MAPPING: { struct mapping *m;
19961b2017-04-08Martin Nilsson  m=merge_mappings(Pike_sp[-2].u.mapping, Pike_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;
19961b2017-04-08Martin Nilsson  l=merge_multisets(Pike_sp[-2].u.multiset, Pike_sp[-1].u.multiset,
d05ad72016-12-30Martin Nilsson  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; }
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_ARRAY: { struct array *a;
19961b2017-04-08Martin Nilsson  a=and_arrays(Pike_sp[-2].u.array, Pike_sp[-1].u.array);
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
19961b2017-04-08Martin Nilsson  t = and_pike_types(Pike_sp[-2].u.type, Pike_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) 
19961b2017-04-08Martin Nilsson  p = program_from_svalue(Pike_sp - 2);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`&", 1, "type");
13670c2015-05-25Martin Nilsson  }
dc7d491999-12-15Henrik Grubbström (Grubba)  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();
19961b2017-04-08Martin Nilsson  p = program_from_svalue(Pike_sp - 1);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`&", 2, "type");
13670c2015-05-25Martin Nilsson  }
dc7d491999-12-15Henrik Grubbström (Grubba)  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: \ { \
a2a5812013-08-25Arne Goedeke  struct pike_string *s; \
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t len, i; \
a2a5812013-08-25Arne Goedeke  \
19961b2017-04-08Martin Nilsson  len = Pike_sp[-2].u.string->len; \ if (len != Pike_sp[-1].u.string->len) \ PIKE_ERROR("`" #OP, "Bitwise "STROP \ " on strings of different lengths.\n", Pike_sp, 2); \ if(!Pike_sp[-2].u.string->size_shift && !Pike_sp[-1].u.string->size_shift) \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  { \ s = begin_shared_string(len); \ for (i=0; i<len; i++) \
19961b2017-04-08Martin Nilsson  s->str[i] = Pike_sp[-2].u.string->str[i] OP Pike_sp[-1].u.string->str[i]; \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  }else{ \ s = begin_wide_shared_string(len, \
19961b2017-04-08Martin Nilsson  MAXIMUM(Pike_sp[-2].u.string->size_shift, \ Pike_sp[-1].u.string->size_shift)); \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  for (i=0; i<len; i++) \
19961b2017-04-08Martin Nilsson  low_set_index(s,i,index_shared_string(Pike_sp[-2].u.string,i) OP \ index_shared_string(Pike_sp[-1].u.string,i)); \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  } \ pop_n_elems(2); \
a2a5812013-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:
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`&", "Bitwise AND on illegal type.\n", Pike_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) {
3595ea2018-02-12Marcus Comstedt  case 3: func(); /* FALLTHRU */ case 2: func(); /* FALLTHRU */
adbb781998-09-18Fredrik Hübinette (Hubbe)  case 1: return; default: r_speedup((args+1)>>1,func);
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
19961b2017-04-08Martin Nilsson  tmp=*--Pike_sp;
adbb781998-09-18Fredrik Hübinette (Hubbe)  SET_ONERROR(err,do_free_svalue,&tmp); r_speedup(args>>1,func); UNSET_ONERROR(err);
19961b2017-04-08Martin Nilsson  Pike_sp++[0]=tmp;
adbb781998-09-18Fredrik Hübinette (Hubbe)  func(); } }
3c04e81997-03-13Fredrik Hübinette (Hubbe) static void speedup(INT32 args, void (*func)(void)) {
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_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
b912e92018-05-19Arne Goedeke  *! @[`>], @[`<], @[`==] and, in the case of mappings, *! @[hash_value]).
dfceb02003-11-10Martin Stjernholm  *! @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)  *!
b912e92018-05-19Arne Goedeke  *! @note *! If this operator is used with arrays or multisets containing objects *! which implement @[lfun::`==()] but @b{not@} @[lfun::`>()] and *! @[lfun::`<()], the result will be undefined. *!
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) {
06bd612016-01-26Martin Nilsson  case 0: SIMPLE_WRONG_NUM_ARGS_ERROR("`&", 1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: return; case 2: o_and(); return;
07c0731996-06-21Fredrik Hübinette (Hubbe)  default:
c629352016-12-30Martin Nilsson  speedup(args, o_and);
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) {
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) != TYPEOF(Pike_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;
19961b2017-04-08Martin Nilsson  } else if (((TYPEOF(Pike_sp[-1]) == T_TYPE) || (TYPEOF(Pike_sp[-1]) == T_PROGRAM) || (TYPEOF(Pike_sp[-1]) == T_FUNCTION)) && ((TYPEOF(Pike_sp[-2]) == T_TYPE) || (TYPEOF(Pike_sp[-2]) == T_PROGRAM) || (TYPEOF(Pike_sp[-2]) == T_FUNCTION))) { if (TYPEOF(Pike_sp[-2]) != T_TYPE) { struct program *p = program_from_svalue(Pike_sp - 2);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`|", 1, "type");
dc7d491999-12-15Henrik Grubbström (Grubba)  } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp - 2); SET_SVAL(Pike_sp[-2], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[-1]) != T_TYPE) { struct program *p = program_from_svalue(Pike_sp - 1);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`|", 2, "type");
dc7d491999-12-15Henrik Grubbström (Grubba)  } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp - 1); SET_SVAL(Pike_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;
0877722020-03-19Henrik Grubbström (Grubba)  if ((TYPEOF(Pike_sp[-1]) == PIKE_T_INT) && (SUBTYPEOF(Pike_sp[-1]) == NUMBER_UNDEFINED)) { if (TYPEOF(Pike_sp[-2]) == PIKE_T_MULTISET) { struct multiset *l = copy_multiset(Pike_sp[-2].u.multiset); pop_stack(); pop_stack(); push_multiset(l); return; } } else if ((TYPEOF(Pike_sp[-2]) == PIKE_T_INT) && (SUBTYPEOF(Pike_sp[-2]) == NUMBER_UNDEFINED)) { if (TYPEOF(Pike_sp[-1]) == PIKE_T_MULTISET) { struct multiset *l = copy_multiset(Pike_sp[-1].u.multiset); pop_stack(); pop_stack(); push_multiset(l); return; } }
19961b2017-04-08Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`|", 2, get_name_of_type(TYPEOF(Pike_sp[-2])));
54db6c1999-03-27Henrik Grubbström (Grubba)  }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
4d42652016-12-31Martin Nilsson  if(!call_lfun(LFUN_OR,LFUN_ROR))
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`|", "Bitwise or on objects without `| operator.\n", Pike_sp, 2);
4d42652016-12-31Martin Nilsson  return;
07c0731996-06-21Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT:
19961b2017-04-08Martin Nilsson  Pike_sp--; SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, Pike_sp[-1].u.integer | Pike_sp[0].u.integer);
4d42652016-12-31Martin Nilsson  return;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_MAPPING: { struct mapping *m;
19961b2017-04-08Martin Nilsson  m=merge_mappings(Pike_sp[-2].u.mapping, Pike_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;
19961b2017-04-08Martin Nilsson  l=merge_multisets(Pike_sp[-2].u.multiset, Pike_sp[-1].u.multiset,
d05ad72016-12-30Martin Nilsson  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; }
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_ARRAY: {
19961b2017-04-08Martin Nilsson  if (Pike_sp[-1].u.array->size == 1) {
5768c22009-09-07Henrik Grubbström (Grubba)  /* Common case (typically the |= operator). */
19961b2017-04-08Martin Nilsson  int i = array_search(Pike_sp[-2].u.array, Pike_sp[-1].u.array->item, 0);
5768c22009-09-07Henrik Grubbström (Grubba)  if (i == -1) { f_add(2); } else { pop_stack(); }
19961b2017-04-08Martin Nilsson  } else if ((Pike_sp[-2].u.array == Pike_sp[-1].u.array) && (Pike_sp[-1].u.array->refs == 2)) {
5768c22009-09-07Henrik Grubbström (Grubba)  /* Not common, but easy to detect... */ pop_stack(); } else { struct array *a;
19961b2017-04-08Martin Nilsson  a=merge_array_with_order(Pike_sp[-2].u.array, Pike_sp[-1].u.array,
5768c22009-09-07Henrik Grubbström (Grubba)  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;
19961b2017-04-08Martin Nilsson  t = or_pike_types(Pike_sp[-2].u.type, Pike_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) 
19961b2017-04-08Martin Nilsson  p = program_from_svalue(Pike_sp - 2);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`|", 1, "type");
dc7d491999-12-15Henrik Grubbström (Grubba)  } 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();
19961b2017-04-08Martin Nilsson  p = program_from_svalue(Pike_sp - 1);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`|", 2, "type");
dc7d491999-12-15Henrik Grubbström (Grubba)  } 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:
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`|", "Bitwise OR on illegal type.\n", Pike_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].
0877722020-03-19Henrik Grubbström (Grubba)  *! @type zero *! @[UNDEFINED] may be or:ed with multisets, behaving as if *! it was an empty multiset.
dfceb02003-11-10Martin Stjernholm  *! @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
b912e92018-05-19Arne Goedeke  *! @[arg1] (according to @[`>], @[`<], @[`==]). The order *! between the elements that come from the same argument is kept.
dfceb02003-11-10Martin Stjernholm  *! *! 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
0877722020-03-19Henrik Grubbström (Grubba)  *! @[arg2] that don't already occur in @[arg1] (according to
b912e92018-05-19Arne Goedeke  *! @[`>], @[`<] and @[`==]). Subsequences with orderwise equal *! entries (i.e. where @[`<] returns false) are handled just *! like the array case above.
dfceb02003-11-10Martin Stjernholm  *! @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)  *!
b912e92018-05-19Arne Goedeke  *! @note *! If this operator is used with arrays or multisets containing objects *! which implement @[lfun::`==()] but @b{not@} @[lfun::`>()] and *! @[lfun::`<()], the result will be undefined. *!
0877722020-03-19Henrik Grubbström (Grubba)  *! The treatment of @[UNDEFINED] with multisets was new in Pike 8.1. *!
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) {
06bd612016-01-26Martin Nilsson  case 0: SIMPLE_WRONG_NUM_ARGS_ERROR("`|", 1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: return; case 2: o_or(); return;
07c0731996-06-21Fredrik Hübinette (Hubbe)  default:
c629352016-12-30Martin Nilsson  speedup(args, o_or);
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) {
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-1]) != TYPEOF(Pike_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;
19961b2017-04-08Martin Nilsson  } else if (((TYPEOF(Pike_sp[-1]) == T_TYPE) || (TYPEOF(Pike_sp[-1]) == T_PROGRAM) || (TYPEOF(Pike_sp[-1]) == T_FUNCTION)) && ((TYPEOF(Pike_sp[-2]) == T_TYPE) || (TYPEOF(Pike_sp[-2]) == T_PROGRAM) || (TYPEOF(Pike_sp[-2]) == T_FUNCTION))) { if (TYPEOF(Pike_sp[-2]) != T_TYPE) { struct program *p = program_from_svalue(Pike_sp - 2);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`^", 1, "type");
dc7d491999-12-15Henrik Grubbström (Grubba)  } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp - 2); SET_SVAL(Pike_sp[-2], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
19961b2017-04-08Martin Nilsson  if (TYPEOF(Pike_sp[-1]) != T_TYPE) { struct program *p = program_from_svalue(Pike_sp - 1);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`^", 2, "type");
dc7d491999-12-15Henrik Grubbström (Grubba)  } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp - 1); SET_SVAL(Pike_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;
19961b2017-04-08Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`^", 2, get_name_of_type(TYPEOF(Pike_sp[-2])));
54db6c1999-03-27Henrik Grubbström (Grubba)  }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
2a89252016-12-30Martin Nilsson  if(!call_lfun(LFUN_XOR,LFUN_RXOR))
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`^", "Bitwise xor on objects without `^ operator.\n", Pike_sp, 2);
4d42652016-12-31Martin Nilsson  return;
07c0731996-06-21Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT:
19961b2017-04-08Martin Nilsson  Pike_sp--; SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, Pike_sp[-1].u.integer ^ Pike_sp[0].u.integer);
4d42652016-12-31Martin Nilsson  return;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_MAPPING: { struct mapping *m;
19961b2017-04-08Martin Nilsson  m=merge_mappings(Pike_sp[-2].u.mapping, Pike_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;
19961b2017-04-08Martin Nilsson  l=merge_multisets(Pike_sp[-2].u.multiset, Pike_sp[-1].u.multiset,
d05ad72016-12-30Martin Nilsson  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; }
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_ARRAY: { struct array *a;
19961b2017-04-08Martin Nilsson  a=merge_array_with_order(Pike_sp[-2].u.array, Pike_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;
19961b2017-04-08Martin Nilsson  p = program_from_svalue(Pike_sp - 1);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`^", 2, "type");
dc7d491999-12-15Henrik Grubbström (Grubba)  } 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();
19961b2017-04-08Martin Nilsson  p = program_from_svalue(Pike_sp - 1);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) { int args = 2; stack_swap();
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`^", 1, "type");
dc7d491999-12-15Henrik Grubbström (Grubba)  } 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)  }
5f50842018-02-12Marcus Comstedt  /* FALLTHRU */
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;
19961b2017-04-08Martin Nilsson  copy_pike_type(a, Pike_sp[-2].u.type); copy_pike_type(b, Pike_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:
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`^", "Bitwise XOR on illegal type.\n", Pike_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]
b912e92018-05-19Arne Goedeke  *! that doesn't occur in @[arg1] (according to @[`>], @[`<] and *! @[`==]). The order between the elements that come from the *! same argument is kept.
dfceb02003-11-10Martin Stjernholm  *! *! 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
b912e92018-05-19Arne Goedeke  *! @[`>], @[`<] and @[`==]). Subsequences with orderwise equal
dfceb02003-11-10Martin Stjernholm  *! 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)  *!
b912e92018-05-19Arne Goedeke  *! @note *! If this operator is used with arrays or multisets containing objects *! which implement @[lfun::`==()] but @b{not@} @[lfun::`>()] and *! @[lfun::`<()], the result will be undefined. *!
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) {
06bd612016-01-26Martin Nilsson  case 0: SIMPLE_WRONG_NUM_ARGS_ERROR("`^", 1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: return; case 2: o_xor(); return;
07c0731996-06-21Fredrik Hübinette (Hubbe)  default:
c629352016-12-30Martin Nilsson  speedup(args, o_xor);
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) {
a320e52015-09-16Henrik Grubbström (Grubba)  int args = 2;
19961b2017-04-08Martin Nilsson  if ((TYPEOF(Pike_sp[-2]) == T_OBJECT) || (TYPEOF(Pike_sp[-1]) == T_OBJECT))
a320e52015-09-16Henrik Grubbström (Grubba)  goto call_lfun;
19961b2017-04-08Martin Nilsson  if ((TYPEOF(Pike_sp[-1]) != T_INT) || (Pike_sp[-1].u.integer < 0)) {
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`<<", 2, "int(0..)|object");
37f1a82014-08-31Per Hedbor  }
a320e52015-09-16Henrik Grubbström (Grubba) 
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-2])) {
a320e52015-09-16Henrik Grubbström (Grubba)  case T_INT:
19961b2017-04-08Martin Nilsson  if (!INT_TYPE_LSH_OVERFLOW(Pike_sp[-2].u.integer, Pike_sp[-1].u.integer))
a320e52015-09-16Henrik Grubbström (Grubba)  break;
ff0d461999-10-15Fredrik Noring  convert_stack_top_to_bignum();
0311712013-06-17Martin Nilsson 
5f50842018-02-12Marcus Comstedt  /* FALLTHRU */
a320e52015-09-16Henrik Grubbström (Grubba)  case T_OBJECT: call_lfun:
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(call_lfun(LFUN_LSH, LFUN_RLSH))
07c0731996-06-21Fredrik Hübinette (Hubbe)  return;
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-2]) != T_INT)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`<<", 1, "int|float|object"); SIMPLE_ARG_TYPE_ERROR("`<<", 2, "int(0..)|object");
a320e52015-09-16Henrik Grubbström (Grubba)  break; case T_FLOAT:
19961b2017-04-08Martin Nilsson  Pike_sp--; Pike_sp[-1].u.float_number = ldexp(Pike_sp[-1].u.float_number, Pike_sp->u.integer);
a320e52015-09-16Henrik Grubbström (Grubba)  return; default:
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`<<", 1, "int|float|object");
a320e52015-09-16Henrik Grubbström (Grubba)  break;
07c0731996-06-21Fredrik Hübinette (Hubbe)  }
0311712013-06-17Martin Nilsson 
19961b2017-04-08Martin Nilsson  Pike_sp--; SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, Pike_sp[-1].u.integer << Pike_sp->u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a320e52015-09-16Henrik Grubbström (Grubba) /*! @decl int `<<(int arg1, int(0..) arg2) *! @decl mixed `<<(object arg1, int(0..)|object arg2)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mixed `<<(int arg1, object arg2)
a320e52015-09-16Henrik Grubbström (Grubba)  *! @decl mixed `<<(float arg1, int(0..) 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)  *!
a320e52015-09-16Henrik Grubbström (Grubba)  *! If @[arg1] is a float and @[arg2] is a non-negative integer, *! @[arg1] will be multiplied by @expr{1<<@[arg2]@}. *!
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) {
06bd612016-01-26Martin Nilsson  if(args != 2) SIMPLE_WRONG_NUM_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) {
a320e52015-09-16Henrik Grubbström (Grubba)  int args = 2;
19961b2017-04-08Martin Nilsson  if ((TYPEOF(Pike_sp[-2]) == T_OBJECT) || (TYPEOF(Pike_sp[-1]) == T_OBJECT))
07c0731996-06-21Fredrik Hübinette (Hubbe)  {
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(call_lfun(LFUN_RSH, LFUN_RRSH))
07c0731996-06-21Fredrik Hübinette (Hubbe)  return;
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-2]) != T_INT)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`>>", 1, "int|object"); SIMPLE_ARG_TYPE_ERROR("`>>", 2, "int(0..)|object");
07c0731996-06-21Fredrik Hübinette (Hubbe)  }
13670c2015-05-25Martin Nilsson 
19961b2017-04-08Martin Nilsson  if ((TYPEOF(Pike_sp[-1]) != T_INT) || (Pike_sp[-1].u.integer < 0)) {
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`>>", 2, "int(0..)|object");
ba18302002-04-20Johan Sundström  }
b019632002-10-15Henrik Grubbström (Grubba) 
19961b2017-04-08Martin Nilsson  Pike_sp--; switch(TYPEOF(Pike_sp[-1])) {
a320e52015-09-16Henrik Grubbström (Grubba)  case T_INT:
19961b2017-04-08Martin Nilsson  if( INT_TYPE_RSH_OVERFLOW(Pike_sp[-1].u.integer, Pike_sp->u.integer) )
a320e52015-09-16Henrik Grubbström (Grubba)  {
19961b2017-04-08Martin Nilsson  if (Pike_sp[-1].u.integer < 0) { SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, -1);
a320e52015-09-16Henrik Grubbström (Grubba)  } else {
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, 0);
a320e52015-09-16Henrik Grubbström (Grubba)  } return;
ba18302002-04-20Johan Sundström  }
a320e52015-09-16Henrik Grubbström (Grubba)  break; case T_FLOAT:
19961b2017-04-08Martin Nilsson  Pike_sp[-1].u.float_number = ldexp(Pike_sp[-1].u.float_number, -Pike_sp->u.integer);
ba18302002-04-20Johan Sundström  return;
a320e52015-09-16Henrik Grubbström (Grubba)  default:
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`>>", 1, "int|float|object");
a320e52015-09-16Henrik Grubbström (Grubba)  break;
ba18302002-04-20Johan Sundström  }
13670c2015-05-25Martin Nilsson 
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, Pike_sp[-1].u.integer >> Pike_sp->u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a320e52015-09-16Henrik Grubbström (Grubba) /*! @decl int `>>(int arg1, int(0..) arg2) *! @decl mixed `>>(object arg1, int(0..)|object arg2)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mixed `>>(int arg1, object arg2)
a320e52015-09-16Henrik Grubbström (Grubba)  *! @decl float `>>(float arg1, int(0..) 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)  *!
a320e52015-09-16Henrik Grubbström (Grubba)  *! If @[arg1] is a float and @[arg2] is a non-negative integer, *! @[arg1] will be divided by @expr{1<<@[arg2]@}. *!
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) {
06bd612016-01-26Martin Nilsson  if(args != 2) SIMPLE_WRONG_NUM_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;
19961b2017-04-08Martin Nilsson  switch(TWO_TYPES(TYPEOF(Pike_sp[-2]), TYPEOF(Pike_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;
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.integer < 0)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`*", 2, "int(0..)");
19961b2017-04-08Martin Nilsson  ret=allocate_array(Pike_sp[-2].u.array->size * Pike_sp[-1].u.integer);
1b61661998-02-19Fredrik Hübinette (Hubbe)  pos=ret->item;
19961b2017-04-08Martin Nilsson  for(e=0;e<Pike_sp[-1].u.integer;e++,pos+=Pike_sp[-2].u.array->size)
1b61661998-02-19Fredrik Hübinette (Hubbe)  assign_svalues_no_free(pos,
19961b2017-04-08Martin Nilsson  Pike_sp[-2].u.array->item, Pike_sp[-2].u.array->size, Pike_sp[-2].u.array->type_field); ret->type_field=Pike_sp[-2].u.array->type_field;
1b61661998-02-19Fredrik Hübinette (Hubbe)  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;
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.float_number < 0)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`*", 2, "float(0..)");
7c46f22000-10-15Henrik Grubbström (Grubba) 
19961b2017-04-08Martin Nilsson  src = Pike_sp[-2].u.array;
7c46f22000-10-15Henrik Grubbström (Grubba)  delta = src->size;
19961b2017-04-08Martin Nilsson  asize = (ptrdiff_t)floor(delta * Pike_sp[-1].u.float_number + 0.5);
7c46f22000-10-15Henrik Grubbström (Grubba)  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;
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.float_number < 0)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`*", 2, "float(0..)");
19961b2017-04-08Martin Nilsson  src = Pike_sp[-2].u.string; len = (ptrdiff_t)floor(src->len * Pike_sp[-1].u.float_number + 0.5);
7c46f22000-10-15Henrik Grubbström (Grubba)  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) {
59fc9e2014-09-03Martin Nilsson  memcpy(pos, src->str, delta);
7c46f22000-10-15Henrik Grubbström (Grubba)  pos += delta; len -= delta;
fa95e62000-10-15Henrik Grubbström (Grubba)  while (len > delta) {
59fc9e2014-09-03Martin Nilsson  memcpy(pos, ret->str, delta);
7c46f22000-10-15Henrik Grubbström (Grubba)  pos += delta; len -= delta; delta <<= 1; } if (len) {
59fc9e2014-09-03Martin Nilsson  memcpy(pos, ret->str, len);
7c46f22000-10-15Henrik Grubbström (Grubba)  } } else if (len) {
59fc9e2014-09-03Martin Nilsson  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;
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.integer < 0)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`*", 2, "int(0..)");
19961b2017-04-08Martin Nilsson  ret=begin_wide_shared_string(Pike_sp[-2].u.string->len * Pike_sp[-1].u.integer, Pike_sp[-2].u.string->size_shift);
1b61661998-02-19Fredrik Hübinette (Hubbe)  pos=ret->str;
19961b2017-04-08Martin Nilsson  len=Pike_sp[-2].u.string->len << Pike_sp[-2].u.string->size_shift; for(e=0;e<Pike_sp[-1].u.integer;e++,pos+=len) memcpy(pos,Pike_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;
19961b2017-04-08Martin Nilsson  ret=implode(Pike_sp[-2].u.array,Pike_sp[-1].u.string); free_string(Pike_sp[-1].u.string); free_array(Pike_sp[-2].u.array); SET_SVAL(Pike_sp[-2], T_STRING, 0, string, ret); Pike_sp--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
f5466b1997-02-18Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_ARRAY,T_ARRAY): { struct array *ret;
19961b2017-04-08Martin Nilsson  ret=implode_array(Pike_sp[-2].u.array, Pike_sp[-1].u.array);
f5466b1997-02-18Fredrik Hübinette (Hubbe)  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):
19961b2017-04-08Martin Nilsson  Pike_sp--; Pike_sp[-1].u.float_number *= Pike_sp[0].u.float_number;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_FLOAT,T_INT):
19961b2017-04-08Martin Nilsson  Pike_sp--; Pike_sp[-1].u.float_number *= (FLOAT_TYPE)Pike_sp[0].u.integer;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  return; case TWO_TYPES(T_INT,T_FLOAT):
19961b2017-04-08Martin Nilsson  Pike_sp--; Pike_sp[-1].u.float_number= (FLOAT_TYPE) Pike_sp[-1].u.integer * Pike_sp[0].u.float_number; SET_SVAL_TYPE(Pike_sp[-1], T_FLOAT);
bce86c1996-02-25Fredrik Hübinette (Hubbe)  return; case TWO_TYPES(T_INT,T_INT):
f306632012-12-31Arne Goedeke  { INT_TYPE res;
19961b2017-04-08Martin Nilsson  if (DO_INT_TYPE_MUL_OVERFLOW(Pike_sp[-2].u.integer, Pike_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  }
0311712013-06-17Martin Nilsson 
19961b2017-04-08Martin Nilsson  Pike_sp--; SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, res);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
f306632012-12-31Arne Goedeke  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  do_lfun_multiply:
4d42652016-12-31Martin Nilsson  if(!call_lfun(LFUN_MULTIPLY, LFUN_RMULTIPLY))
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`*", "Multiplication on objects without `* operator.\n", Pike_sp, 2);
4d42652016-12-31Martin Nilsson  return;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  /*! @decl object|int|float `**(object|int|float arg1, object|int|float arg2) *! *! Exponentiation. Raise arg1 to the power of arg2. *! */
fbff332016-05-17Per Hedbor PMOD_EXPORT void f_exponent(INT32 args) {
9e10fe2020-06-06Marcus Comstedt  FLOAT_ARG_TYPE a, b;
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  if(args != 2 ) SIMPLE_WRONG_NUM_ARGS_ERROR("`**",2);
fbff332016-05-17Per Hedbor 
19961b2017-04-08Martin Nilsson  switch( TWO_TYPES(TYPEOF(Pike_sp[-2]), TYPEOF(Pike_sp[-1])) )
7ed4c82016-05-17Per Hedbor  { case TWO_TYPES(T_FLOAT,T_FLOAT):
19961b2017-04-08Martin Nilsson  a = Pike_sp[-2].u.float_number; b = Pike_sp[-1].u.float_number;
7ed4c82016-05-17Per Hedbor  goto res_is_powf;
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  case TWO_TYPES(T_FLOAT,T_INT):
19961b2017-04-08Martin Nilsson  a = Pike_sp[-2].u.float_number;
9e10fe2020-06-06Marcus Comstedt  b = (FLOAT_ARG_TYPE)Pike_sp[-1].u.integer;
7ed4c82016-05-17Per Hedbor  goto res_is_powf;
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  case TWO_TYPES(T_INT,T_FLOAT):
9e10fe2020-06-06Marcus Comstedt  a = (FLOAT_ARG_TYPE)Pike_sp[-2].u.integer; b = (FLOAT_ARG_TYPE)Pike_sp[-1].u.float_number;
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  res_is_powf: {
19961b2017-04-08Martin Nilsson  Pike_sp-=2;
9e10fe2020-06-06Marcus Comstedt #if SIZEOF_FLOAT_TYPE > SIZEOF_DOUBLE push_float( powl( a, b ) ); #else push_float( pow( a, b ) ); #endif
7259032016-05-17Per Hedbor  return;
7ed4c82016-05-17Per Hedbor  } default: stack_swap(); convert_stack_top_to_bignum(); stack_swap();
5f50842018-02-12Marcus Comstedt  /* FALLTHRU *//* again (this is the slow path).. */
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  case TWO_TYPES(T_OBJECT,T_INT):
5f6ffc2016-05-18Per Hedbor  case TWO_TYPES(T_OBJECT,T_FLOAT):
7ed4c82016-05-17Per Hedbor  case TWO_TYPES(T_OBJECT,T_OBJECT):
5f6ffc2016-05-18Per Hedbor  case TWO_TYPES(T_INT,T_OBJECT): case TWO_TYPES(T_FLOAT,T_OBJECT):
7ed4c82016-05-17Per Hedbor  if( !call_lfun( LFUN_POW, LFUN_RPOW ) )
5f6ffc2016-05-18Per Hedbor  {
19961b2017-04-08Martin Nilsson  if( TYPEOF(Pike_sp[-2]) != PIKE_T_OBJECT )
5f6ffc2016-05-18Per Hedbor  { stack_swap(); convert_stack_top_to_bignum(); stack_swap(); if( call_lfun( LFUN_POW, LFUN_RPOW ) ) return; } Pike_error("Illegal argument 1 to `** (object missing implementation of `**).\n"); }
7ed4c82016-05-17Per Hedbor  return; }
fbff332016-05-17Per Hedbor }
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) {
06bd612016-01-26Martin Nilsson  case 0: SIMPLE_WRONG_NUM_ARGS_ERROR("`*", 1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: return; case 2: o_multiply(); return;
07c0731996-06-21Fredrik Hübinette (Hubbe)  default: {
0c60972000-09-22Henrik Grubbström (Grubba)  INT32 i = -args, j = -1; /* Reverse the arguments */ while(i < j) {
19961b2017-04-08Martin Nilsson  struct svalue tmp = Pike_sp[i]; Pike_sp[i++] = Pike_sp[j]; Pike_sp[j--] = tmp;
0c60972000-09-22Henrik Grubbström (Grubba)  } 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) {
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-2]) != TYPEOF(Pike_sp[-1]) && !float_promote())
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  { if(call_lfun(LFUN_DIVIDE, LFUN_RDIVIDE)) return;
1b61661998-02-19Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  switch(TWO_TYPES(TYPEOF(Pike_sp[-2]), TYPEOF(Pike_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) 
19961b2017-04-08Martin Nilsson  len=Pike_sp[-1].u.integer;
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(!len)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) { len=-len;
19961b2017-04-08Martin Nilsson  size=Pike_sp[-2].u.string->len / len; pos+=Pike_sp[-2].u.string->len % len;
d429a71998-02-24Fredrik Hübinette (Hubbe)  }else{
19961b2017-04-08Martin Nilsson  size=Pike_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,
19961b2017-04-08Martin Nilsson  string_slice(Pike_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) 
19961b2017-04-08Martin Nilsson  len=Pike_sp[-1].u.float_number;
1b61661998-02-19Fredrik Hübinette (Hubbe)  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;
19961b2017-04-08Martin Nilsson  size=(ptrdiff_t)ceil( ((double)Pike_sp[-2].u.string->len) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
13670c2015-05-25Martin Nilsson 
19961b2017-04-08Martin Nilsson  for(last=Pike_sp[-2].u.string->len,e=0;e<size-1;e++)
1b61661998-02-19Fredrik Hübinette (Hubbe)  {
19961b2017-04-08Martin Nilsson  pos=Pike_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,
19961b2017-04-08Martin Nilsson  string_slice(Pike_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,
19961b2017-04-08Martin Nilsson  string_slice(Pike_sp[-2].u.string, pos, last-pos));
1b61661998-02-19Fredrik Hübinette (Hubbe)  }else{
19961b2017-04-08Martin Nilsson  size=(ptrdiff_t)ceil( ((double)Pike_sp[-2].u.string->len) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
13670c2015-05-25Martin Nilsson 
d429a71998-02-24Fredrik Hübinette (Hubbe)  for(last=0,e=0;e<size-1;e++)
1b61661998-02-19Fredrik Hübinette (Hubbe)  {
bd67392015-10-14Martin Nilsson  pos = (ptrdiff_t)((e+1)*len+0.5);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_STRING, 0, string,
19961b2017-04-08Martin Nilsson  string_slice(Pike_sp[-2].u.string, last, pos-last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  last=pos; }
19961b2017-04-08Martin Nilsson  pos=Pike_sp[-2].u.string->len;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_STRING, 0, string,
19961b2017-04-08Martin Nilsson  string_slice(Pike_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)  }
13670c2015-05-25Martin Nilsson 
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) 
19961b2017-04-08Martin Nilsson  INT_TYPE len=Pike_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; }
13670c2015-05-25Martin Nilsson 
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) {
6f49401998-07-31Henrik Grubbström (Grubba)  len = -len;
19961b2017-04-08Martin Nilsson  pos = Pike_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)  }
19961b2017-04-08Martin Nilsson  size = Pike_sp[-2].u.array->size / len;
6f49401998-07-31Henrik Grubbström (Grubba) 
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,
19961b2017-04-08Martin Nilsson  friendly_slice_array(Pike_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) 
19961b2017-04-08Martin Nilsson  len=Pike_sp[-1].u.float_number;
1b61661998-02-19Fredrik Hübinette (Hubbe)  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;
19961b2017-04-08Martin Nilsson  size = (ptrdiff_t)ceil( ((double)Pike_sp[-2].u.array->size) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
13670c2015-05-25Martin Nilsson 
19961b2017-04-08Martin Nilsson  for(last=Pike_sp[-2].u.array->size,e=0;e<size-1;e++)
1b61661998-02-19Fredrik Hübinette (Hubbe)  {
19961b2017-04-08Martin Nilsson  pos=Pike_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,
19961b2017-04-08Martin Nilsson  friendly_slice_array(Pike_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,
19961b2017-04-08Martin Nilsson  slice_array(Pike_sp[-2].u.array, 0, last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  }else{
19961b2017-04-08Martin Nilsson  size = (ptrdiff_t)ceil( ((double)Pike_sp[-2].u.array->size) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
13670c2015-05-25Martin Nilsson 
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,
19961b2017-04-08Martin Nilsson  friendly_slice_array(Pike_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,
19961b2017-04-08Martin Nilsson  slice_array(Pike_sp[-2].u.array, last, Pike_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)  } }
13670c2015-05-25Martin Nilsson 
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`/", "Division on different types.\n", Pike_sp, 2);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
4d42652016-12-31Martin Nilsson  if(!call_lfun(LFUN_DIVIDE,LFUN_RDIVIDE))
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`/", "Division on objects without `/ operator.\n", Pike_sp, 2);
2a89252016-12-30Martin Nilsson  return;
07c0731996-06-21Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_STRING: { struct array *ret;
19961b2017-04-08Martin Nilsson  ret=explode(Pike_sp[-2].u.string,Pike_sp[-1].u.string); free_string(Pike_sp[-2].u.string); free_string(Pike_sp[-1].u.string); SET_SVAL(Pike_sp[-2], T_ARRAY, 0, array, ret); Pike_sp--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
f5466b1997-02-18Fredrik Hübinette (Hubbe)  case T_ARRAY: {
19961b2017-04-08Martin Nilsson  struct array *ret=explode_array(Pike_sp[-2].u.array, Pike_sp[-1].u.array);
f5466b1997-02-18Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_array(ret); return; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT:
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.float_number == 0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
19961b2017-04-08Martin Nilsson  Pike_sp--; Pike_sp[-1].u.float_number /= Pike_sp[0].u.float_number;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; case T_INT:
806a2c1997-04-28Fredrik Hübinette (Hubbe)  {
e4b2252000-08-09Henrik Grubbström (Grubba)  INT_TYPE tmp;
13670c2015-05-25Martin Nilsson 
19961b2017-04-08Martin Nilsson  if (Pike_sp[-1].u.integer == 0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
806a2c1997-04-28Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  if(INT_TYPE_DIV_OVERFLOW(Pike_sp[-2].u.integer, Pike_sp[-1].u.integer))
08b9801999-10-30Fredrik Noring  { stack_swap(); convert_stack_top_to_bignum(); stack_swap();
b0f5282019-08-09Henrik Grubbström (Grubba)  if (LIKELY(call_lfun(LFUN_DIVIDE,LFUN_RDIVIDE))) { return; } Pike_fatal("Failed to call `/() in bignum.\n");
08b9801999-10-30Fredrik Noring  } else
19961b2017-04-08Martin Nilsson  tmp = Pike_sp[-2].u.integer/Pike_sp[-1].u.integer; Pike_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 */
19961b2017-04-08Martin Nilsson  if((Pike_sp[-1].u.integer<0) != (Pike_sp[0].u.integer<0)) if(tmp*Pike_sp[0].u.integer!=Pike_sp[-1].u.integer)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  tmp--;
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, tmp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
806a2c1997-04-28Fredrik Hübinette (Hubbe)  }
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`/", "Bad argument 1.\n", Pike_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) {
13670c2015-05-25Martin Nilsson  case 0:
06bd612016-01-26Martin Nilsson  case 1: SIMPLE_WRONG_NUM_ARGS_ERROR("`/", 2);
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  case 2: o_divide(); break; default: { INT32 e;
19961b2017-04-08Martin Nilsson  struct svalue *s=Pike_sp-args;
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  push_svalue(s); for(e=1;e<args;e++) { push_svalue(s+e); o_divide(); }
19961b2017-04-08Martin Nilsson  assign_svalue(s,Pike_sp-1); pop_n_elems(Pike_sp-s-1);
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  } }
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) {
19961b2017-04-08Martin Nilsson  if(TYPEOF(Pike_sp[-2]) != TYPEOF(Pike_sp[-1]) && !float_promote())
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
34e2782013-01-11Arne Goedeke do_lfun_modulo:
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(call_lfun(LFUN_MOD, LFUN_RMOD)) return;
19961b2017-04-08Martin Nilsson  switch(TWO_TYPES(TYPEOF(Pike_sp[-2]), TYPEOF(Pike_sp[-1])))
1b61661998-02-19Fredrik Hübinette (Hubbe)  { case TWO_TYPES(T_STRING,T_INT): {
19961b2017-04-08Martin Nilsson  struct pike_string *s=Pike_sp[-2].u.string;
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t tmp,base;
19961b2017-04-08Martin Nilsson  if(!Pike_sp[-1].u.integer)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
1b61661998-02-19Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.integer<0)
d429a71998-02-24Fredrik Hübinette (Hubbe)  {
19961b2017-04-08Martin Nilsson  tmp=s->len % -Pike_sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=0; }else{
19961b2017-04-08Martin Nilsson  tmp=s->len % Pike_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): {
19961b2017-04-08Martin Nilsson  struct array *a=Pike_sp[-2].u.array;
6e34c62003-11-13Martin Stjernholm  ptrdiff_t tmp,base;
19961b2017-04-08Martin Nilsson  if(!Pike_sp[-1].u.integer)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
1b61661998-02-19Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.integer<0)
d429a71998-02-24Fredrik Hübinette (Hubbe)  {
19961b2017-04-08Martin Nilsson  tmp=a->size % -Pike_sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=0; }else{
19961b2017-04-08Martin Nilsson  tmp=a->size % Pike_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; } }
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`%", "Modulo on different types.\n", Pike_sp, 2);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
2a89252016-12-30Martin Nilsson  if(!call_lfun(LFUN_MOD,LFUN_RMOD))
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`%", "Modulo on objects without `% operator.\n", Pike_sp, 2);
2a89252016-12-30Martin Nilsson  return;
07c0731996-06-21Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT: { FLOAT_TYPE foo;
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.float_number == 0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
19961b2017-04-08Martin Nilsson  Pike_sp--; foo = (FLOAT_TYPE)(Pike_sp[-1].u.float_number / Pike_sp[0].u.float_number); foo = (FLOAT_TYPE)(Pike_sp[-1].u.float_number - Pike_sp[0].u.float_number * floor(foo)); Pike_sp[-1].u.float_number=foo;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; } case T_INT:
34e2782013-01-11Arne Goedeke  { int of = 0;
19961b2017-04-08Martin Nilsson  INT_TYPE a = Pike_sp[-2].u.integer, b = Pike_sp[-1].u.integer;
34e2782013-01-11Arne Goedeke  INT_TYPE res; if (b == 0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
34e2782013-01-11Arne Goedeke  if(a>=0)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  {
34e2782013-01-11Arne Goedeke  if(b>=0)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  {
34e2782013-01-11Arne Goedeke  res = a % b;
806a2c1997-04-28Fredrik Hübinette (Hubbe)  }else{
34e2782013-01-11Arne Goedeke  /* res = ((a+~b)%-b)-~b */
fe62692014-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{
34e2782013-01-11Arne Goedeke  if(b>=0)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  {
34e2782013-01-11Arne Goedeke  /* res = b+~((~a) % b) */
fe62692014-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{
34e2782013-01-11Arne Goedeke  /* a % b and a % -b are equivalent, if overflow does not * happen * res = -(-a % -b) = a % b; */
fe62692014-01-11Arne Goedeke  of = DO_INT_TYPE_MOD_OVERFLOW(a, b, &res);
806a2c1997-04-28Fredrik Hübinette (Hubbe)  } }
34e2782013-01-11Arne Goedeke  if (of) { stack_swap(); convert_stack_top_to_bignum(); stack_swap(); goto do_lfun_modulo; }
19961b2017-04-08Martin Nilsson  Pike_sp--; SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, res);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
34e2782013-01-11Arne Goedeke  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`%", "Bad argument 1.\n", Pike_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
cf559f2015-10-08Henrik Grubbström (Grubba)  *! @expr{a % b@} always has the same sign as @expr{b@} *! (typically @expr{b@} is positive; *! array size, rsa modulo, etc, and @expr{a@} varies a *! lot more than @expr{b@}).
b8d9a02003-01-15Johan Sundström  *! @item
cf559f2015-10-08Henrik Grubbström (Grubba)  *! The function @expr{f(x) = x % n@} behaves in a sane way; *! as @expr{x@} increases, @expr{f(x)@} cycles through the *! values @expr{0,1, ..., n-1, 0, ...@}. Nothing
b8d9a02003-01-15Johan Sundström  *! strange happens when you cross zero. *! @item
cf559f2015-10-08Henrik Grubbström (Grubba)  *! The @expr{%@} 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.
b8d9a02003-01-15Johan Sundström  *! @item
cf559f2015-10-08Henrik Grubbström (Grubba)  *! @expr{/@} and @expr{%@} are compatible, so that *! @expr{a == b*@[floor](a/b) + a%b@} for all @expr{a@} and @expr{b@}.
b8d9a02003-01-15Johan Sundström  *! @endol *! @seealso
cf559f2015-10-08Henrik Grubbström (Grubba)  *! @[`/], @[floor()]
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) {
06bd612016-01-26Martin Nilsson  if(args != 2) SIMPLE_WRONG_NUM_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) {
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_INT:
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, !Pike_sp[-1].u.integer);
07c0731996-06-21Fredrik Hübinette (Hubbe)  break; case T_FUNCTION: case T_OBJECT:
19961b2017-04-08Martin Nilsson  if(UNSAFE_IS_ZERO(Pike_sp-1))
07c0731996-06-21Fredrik Hübinette (Hubbe)  { pop_stack(); push_int(1); }else{ pop_stack(); push_int(0); } break; default:
19961b2017-04-08Martin Nilsson  free_svalue(Pike_sp-1); SET_SVAL(Pike_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) {
06bd612016-01-26Martin Nilsson  if(args != 1) SIMPLE_WRONG_NUM_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) {
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
16c23f2016-12-31Martin Nilsson  if(!call_lhs_lfun(LFUN_COMPL,1))
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`~", "Complement on object without `~ operator.\n", Pike_sp, 1);
16c23f2016-12-31Martin Nilsson  stack_pop_keep_top();
07c0731996-06-21Fredrik Hübinette (Hubbe)  break;
13670c2015-05-25Martin Nilsson 
8a630c1996-04-13Fredrik Hübinette (Hubbe)  case T_INT:
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, ~Pike_sp[-1].u.integer);
8a630c1996-04-13Fredrik Hübinette (Hubbe)  break; case T_FLOAT:
19961b2017-04-08Martin Nilsson  Pike_sp[-1].u.float_number = (FLOAT_TYPE) -1.0 - Pike_sp[-1].u.float_number;
8a630c1996-04-13Fredrik Hübinette (Hubbe)  break;
0e801c1999-12-13Henrik Grubbström (Grubba)  case T_TYPE: type_stack_mark();
19961b2017-04-08Martin Nilsson  if (Pike_sp[-1].u.type->type == T_NOT) { push_finished_type(Pike_sp[-1].u.type->car);
dc7d491999-12-15Henrik Grubbström (Grubba)  } else {
19961b2017-04-08Martin Nilsson  push_finished_type(Pike_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) */
19961b2017-04-08Martin Nilsson  struct program *p = program_from_svalue(Pike_sp - 1);
dc7d491999-12-15Henrik Grubbström (Grubba)  if (!p) {
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`~", "Bad argument.\n", Pike_sp, 1);
dc7d491999-12-15Henrik Grubbström (Grubba)  } 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 
19961b2017-04-08Martin Nilsson  if(Pike_sp[-1].u.string->size_shift) {
212c392018-02-25Martin Nilsson  bad_arg_error("`~", 1, 1, "string(0)", Pike_sp-1,
54db6c1999-03-27Henrik Grubbström (Grubba)  "Expected 8-bit string.\n"); }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) 
19961b2017-04-08Martin Nilsson  len = Pike_sp[-1].u.string->len;
fc0bb51997-02-13Niels Möller  s = begin_shared_string(len); for (i=0; i<len; i++)
19961b2017-04-08Martin Nilsson  s->str[i] = ~ Pike_sp[-1].u.string->str[i];
fc0bb51997-02-13Niels Möller  pop_n_elems(1); push_string(end_shared_string(s)); break; }
8a630c1996-04-13Fredrik Hübinette (Hubbe)  default:
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`~", "Bad argument.\n", Pike_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) {
06bd612016-01-26Martin Nilsson  if(args != 1) SIMPLE_WRONG_NUM_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) {
19961b2017-04-08Martin Nilsson  switch(TYPEOF(Pike_sp[-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
ff0d461999-10-15Fredrik Noring  do_lfun_negate:
16c23f2016-12-31Martin Nilsson  if(!call_lhs_lfun(LFUN_SUBTRACT,1))
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`-", "Negate on object without `- operator.\n", Pike_sp, 1);
16c23f2016-12-31Martin Nilsson  stack_pop_keep_top();
07c0731996-06-21Fredrik Hübinette (Hubbe)  break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT:
19961b2017-04-08Martin Nilsson  Pike_sp[-1].u.float_number=-Pike_sp[-1].u.float_number;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT:
19961b2017-04-08Martin Nilsson  if(INT_TYPE_NEG_OVERFLOW(Pike_sp[-1].u.integer))
ff0d461999-10-15Fredrik Noring  { convert_stack_top_to_bignum(); goto do_lfun_negate; }
19961b2017-04-08Martin Nilsson  SET_SVAL(Pike_sp[-1], T_INT, NUMBER_NUMBER, integer, -Pike_sp[-1].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
13670c2015-05-25Martin Nilsson  default:
19961b2017-04-08Martin Nilsson  PIKE_ERROR("`-", "Bad argument to unary minus.\n", Pike_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();
19961b2017-04-08Martin Nilsson  move_svalue (&end_pos, --Pike_sp);
408a1e2004-10-30Martin Stjernholm  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:
19961b2017-04-08Martin Nilsson  move_svalue (Pike_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);
19961b2017-04-08Martin Nilsson  move_svalue (Pike_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:
19961b2017-04-08Martin Nilsson  move_svalue (Pike_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);
19961b2017-04-08Martin Nilsson  move_svalue (Pike_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)  }
f402aa2016-12-08Martin Nilsson  UNREACHABLE(return "Unexpected bound_types");
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;
19961b2017-04-08Martin Nilsson  high = bound_types & RANGE_HIGH_OPEN ? Pike_sp : Pike_sp - 1;
408a1e2004-10-30Martin Stjernholm  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),
212c392018-02-25Martin Nilsson  Pike_sp - ind, 1, "object", ind,
408a1e2004-10-30Martin Stjernholm  "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);
19961b2017-04-08Martin Nilsson  Pike_sp = high;
408a1e2004-10-30Martin Stjernholm  } 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) {
19961b2017-04-08Martin Nilsson  move_svalue (Pike_sp++, &h);
408a1e2004-10-30Martin Stjernholm  push_int (INDEX_FROM_BEG); } else if (bound_types & RANGE_HIGH_OPEN) { push_int (0); push_int (OPEN_BOUND); } else {
19961b2017-04-08Martin Nilsson  move_svalue (Pike_sp++, &h);
408a1e2004-10-30Martin Stjernholm  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),
212c392018-02-25Martin Nilsson  Pike_sp - ind, 1, "object", ind,
408a1e2004-10-30Martin Stjernholm  "Object got neither `[..] nor `[].\n");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  case 2: bad_arg_error (range_func_name (bound_types),
212c392018-02-25Martin Nilsson  Pike_sp - ind, 1, "object", ind,
408a1e2004-10-30Martin Stjernholm  "Object got no `[..] and there is no _sizeof to " "translate the from-the-end index to use `[].\n");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  case 3: bad_arg_error (range_func_name (bound_types),
212c392018-02-25Martin Nilsson  3, 1, "object", ind,
408a1e2004-10-30Martin Stjernholm  "Cannot call `[..] in destructed object.\n");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  default: free_svalue (ind);
19961b2017-04-08Martin Nilsson  move_svalue (ind, Pike_sp - 1);
408a1e2004-10-30Martin Stjernholm  /* low and high have lost their refs in call_old_range_lfun. */
19961b2017-04-08Martin Nilsson  Pike_sp = ind + 1;
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  } 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),
212c392018-02-25Martin Nilsson  Pike_sp - ind, 2, "int", low,
408a1e2004-10-30Martin Stjernholm  "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),
212c392018-02-25Martin Nilsson  Pike_sp - ind, high - ind + 1, "int", high,
408a1e2004-10-30Martin Stjernholm  "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. */
19961b2017-04-08Martin Nilsson  Pike_sp = ind + 1;
408a1e2004-10-30Martin Stjernholm  string_or_array_range (bound_types, ind, l, h); break; } default: bad_arg_error (range_func_name (bound_types),
212c392018-02-25Martin Nilsson  Pike_sp - ind, 1, "string|array|object", ind,
408a1e2004-10-30Martin Stjernholm  "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);
19961b2017-04-08Martin Nilsson  ind = Pike_sp - 5;
408a1e2004-10-30Martin Stjernholm  #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");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  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");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  case 3: SIMPLE_ARG_ERROR ("predef::`[..]", 1, "Cannot call `[..] in destructed object.\n");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  default: free_svalue (ind);
19961b2017-04-08Martin Nilsson  move_svalue (ind, Pike_sp - 1);
408a1e2004-10-30Martin Stjernholm  /* The bound types are simple integers and the bounds * themselves have lost their refs in call_old_range_lfun. */
19961b2017-04-08Martin Nilsson  Pike_sp = ind + 1;
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  } } 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-29M