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) 
6ad2372002-05-11Martin Nilsson #define sp Pike_sp
54db6c1999-03-27Henrik Grubbström (Grubba) #define OP_DIVISION_BY_ZERO_ERROR(FUNC) \ math_error(FUNC, sp-2, 2, 0, "Division by zero.\n") #define OP_MODULO_BY_ZERO_ERROR(FUNC) \ math_error(FUNC, sp-2, 2, 0, "Modulo by zero.\n")
afc93f2010-05-28Martin Stjernholm  /* This calculation should always give some margin based on the size. */ /* It utilizes that log10(256) ~= 2.4 < 5/2. */ /* One extra char for the sign and one for the \0 terminator. */ #define MAX_INT_SPRINTF_LEN (2 + (SIZEOF_INT_TYPE * 5 + 1) / 2)
d6b2382009-07-12Henrik Grubbström (Grubba) 
afc93f2010-05-28Martin Stjernholm  /* Enough to hold a Pike float or int in textform
3aff752008-08-26Stephen R. van den Berg  */
afc93f2010-05-28Martin Stjernholm #define MAX_NUM_BUF (MAXIMUM(MAX_INT_SPRINTF_LEN,MAX_FLOAT_SPRINTF_LEN))
3aff752008-08-26Stephen R. van den Berg 
6898c02003-11-14Martin Stjernholm void index_no_free(struct svalue *to,struct svalue *what,struct svalue *ind) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*what))
6898c02003-11-14Martin Stjernholm  { case T_ARRAY: simple_array_index_no_free(to,what->u.array,ind); break; case T_MAPPING: mapping_index_no_free(to,what->u.mapping,ind); break; case T_OBJECT:
017b572011-10-28Henrik Grubbström (Grubba)  object_index_no_free(to, what->u.object, SUBTYPEOF(*what), ind);
6898c02003-11-14Martin Stjernholm  break; case T_MULTISET: { int i=multiset_member(what->u.multiset, ind);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(*to, T_INT, i ? NUMBER_NUMBER : NUMBER_UNDEFINED, integer, i);
6898c02003-11-14Martin Stjernholm  break; } case T_STRING:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*ind) == T_INT)
6898c02003-11-14Martin Stjernholm  { ptrdiff_t len = what->u.string->len; INT_TYPE p = ind->u.integer; INT_TYPE i = p < 0 ? p + len : p; if(i<0 || i>=len) { if(len == 0) Pike_error("Attempt to index the empty string with %"PRINTPIKEINT"d.\n", i); else Pike_error("Index %"PRINTPIKEINT"d is out of string range " "%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n", i, -len, len - 1); } else i=index_shared_string(what->u.string,i);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(*to, T_INT, NUMBER_NUMBER, integer, i);
6898c02003-11-14Martin Stjernholm  break; }else{
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_STRING)
9606eb2004-11-12Henrik Grubbström (Grubba)  Pike_error ("Expected integer as string index, got \"%S\".\n", ind->u.string);
6898c02003-11-14Martin Stjernholm  else Pike_error ("Expected integer as string index, got %s.\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type (TYPEOF(*ind)));
6898c02003-11-14Martin Stjernholm  } case T_FUNCTION:
354bbe2007-09-24Henrik Grubbström (Grubba)  case T_PROGRAM: if (program_index_no_free(to, what, ind)) break; goto index_error;
6898c02003-11-14Martin Stjernholm  case T_INT:
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_STRING && !IS_UNDEFINED (what)) {
6898c02003-11-14Martin Stjernholm  INT_TYPE val = what->u.integer; convert_svalue_to_bignum(what); index_no_free(to, what, ind); if(IS_UNDEFINED(to)) { if (val) {
9606eb2004-11-12Henrik Grubbström (Grubba)  Pike_error("Indexing the integer %"PRINTPIKEINT"d " "with unknown method \"%S\".\n", val, ind->u.string);
6898c02003-11-14Martin Stjernholm  } else {
9606eb2004-11-12Henrik Grubbström (Grubba)  Pike_error("Indexing the NULL value with \"%S\".\n", ind->u.string);
6898c02003-11-14Martin Stjernholm  } } break; } /* FALL_THROUGH */ default:
354bbe2007-09-24Henrik Grubbström (Grubba)  index_error:
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_INT)
6898c02003-11-14Martin Stjernholm  Pike_error ("Cannot index %s with %"PRINTPIKEINT"d.\n",
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(*what) == T_INT && !what->u.integer)? "the NULL value":get_name_of_type(TYPEOF(*what)),
6898c02003-11-14Martin Stjernholm  ind->u.integer);
017b572011-10-28Henrik Grubbström (Grubba)  else if (TYPEOF(*ind) == T_FLOAT)
4844192009-06-30Martin Stjernholm  Pike_error ("Cannot index %s with %"PRINTPIKEFLOAT"e.\n",
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(*what) == T_INT && !what->u.integer)? "the NULL value":get_name_of_type(TYPEOF(*what)),
6898c02003-11-14Martin Stjernholm  ind->u.float_number);
017b572011-10-28Henrik Grubbström (Grubba)  else if (TYPEOF(*ind) == T_STRING)
9606eb2004-11-12Henrik Grubbström (Grubba)  Pike_error ("Cannot index %s with \"%S\".\n",
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(*what) == T_INT && !what->u.integer)? "the NULL value":get_name_of_type(TYPEOF(*what)),
9606eb2004-11-12Henrik Grubbström (Grubba)  ind->u.string);
6898c02003-11-14Martin Stjernholm  else Pike_error ("Cannot index %s with %s.\n",
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(*what) == T_INT && !what->u.integer)? "the NULL value":get_name_of_type(TYPEOF(*what)), get_name_of_type (TYPEOF(*ind)));
6898c02003-11-14Martin Stjernholm  } }
9d71082012-09-11Stefan Wallström PMOD_EXPORT void o_index(void)
6898c02003-11-14Martin Stjernholm { struct svalue s; index_no_free(&s,sp-2,sp-1); pop_n_elems(2); *sp=s; dmalloc_touch_svalue(sp); sp++; dmalloc_touch_svalue(Pike_sp-1); } /*! @class MasterObject */ /*! @decl object cast_to_object(string str, string|void current_file) *! *! Called by the Pike runtime to cast strings to objects. *! *! @param str *! String to cast to object. *! *! @param current_file *! Filename of the file that attempts to perform the cast. *! *! @returns *! Returns the resulting object. *! *! @seealso *! @[cast_to_program()] */ /*! @decl program cast_to_program(string str, string|void current_file) *! *! Called by the Pike runtime to cast strings to programs. *! *! @param str *! String to cast to object. *! *! @param current_file *! Filename of the file that attempts to perform the cast. *! *! @returns *! Returns the resulting program. *! *! @seealso *! @[cast_to_object()] */ /*! @endclass */ /* Special case for casting to int. */
e7a29a2007-12-28Henrik Grubbström (Grubba) PMOD_EXPORT void o_cast_to_int(void)
6898c02003-11-14Martin Stjernholm {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { case T_OBJECT:
ef8a142004-09-20Martin Stjernholm  if(!sp[-1].u.object->prog) { /* Casting a destructed object should be like casting a zero. */ pop_stack(); push_int (0);
6898c02003-11-14Martin Stjernholm  }
ef8a142004-09-20Martin Stjernholm  else {
6898c02003-11-14Martin Stjernholm  {
ef8a142004-09-20Martin Stjernholm  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  struct program *p = o->prog->inherits[SUBTYPEOF(sp[-1])].prog;
9793b72004-12-18Henrik Grubbström (Grubba)  int f = FIND_LFUN(p, LFUN_CAST);
ef8a142004-09-20Martin Stjernholm  if(f == -1) Pike_error("No cast method in object.\n");
6a932b2014-08-18Martin Nilsson  ref_push_string(literal_int_string);
ef8a142004-09-20Martin Stjernholm  apply_low(o, f, 1); stack_pop_keep_top(); }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != PIKE_T_INT)
ef8a142004-09-20Martin Stjernholm  {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_OBJECT && sp[-1].u.object->prog)
6898c02003-11-14Martin Stjernholm  {
9793b72004-12-18Henrik Grubbström (Grubba)  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN__IS_TYPE);
ef8a142004-09-20Martin Stjernholm  if( f != -1) {
6a932b2014-08-18Martin Nilsson  ref_push_string(literal_int_string);
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, f, 1);
ef8a142004-09-20Martin Stjernholm  f=!UNSAFE_IS_ZERO(sp-1); pop_stack(); if(f) return; }
6898c02003-11-14Martin Stjernholm  }
ef8a142004-09-20Martin Stjernholm  Pike_error("Cast failed, wanted int, got %s\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  }
c43e8c2014-08-16Martin Nilsson  else if(SUBTYPEOF(sp[-1]) == NUMBER_UNDEFINED) Pike_error("Cannot cast this object to int.\n");
6898c02003-11-14Martin Stjernholm  } break;
4998a92015-07-12Arne Goedeke  case T_FLOAT: { FLOAT_TYPE f = sp[-1].u.float_number;
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 { SET_SVAL(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 */
2f260d2009-11-05Henrik Grubbström (Grubba)  if( (sp[-1].u.string->len >= 10) || sp[-1].u.string->size_shift )
6898c02003-11-14Martin Stjernholm  convert_stack_top_string_to_inumber(10);
2f260d2009-11-05Henrik Grubbström (Grubba)  else
6898c02003-11-14Martin Stjernholm  {
2ae97e2014-09-03Martin Nilsson  INT_TYPE i = strtol(sp[-1].u.string->str, 0, 10);
6898c02003-11-14Martin Stjernholm  free_string(sp[-1].u.string);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, i);
6898c02003-11-14Martin Stjernholm  } break; case PIKE_T_INT: break;
13670c2015-05-25Martin Nilsson 
6898c02003-11-14Martin Stjernholm  default:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to int.\n", get_name_of_type(TYPEOF(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;
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { case T_OBJECT:
ef8a142004-09-20Martin Stjernholm  if(!sp[-1].u.object->prog) { /* Casting a destructed object should be like casting a zero. */ pop_stack();
af40e42004-09-20Henrik Grubbström (Grubba)  push_constant_text("0"); } else {
6898c02003-11-14Martin Stjernholm  {
ef8a142004-09-20Martin Stjernholm  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog, LFUN_CAST);
ef8a142004-09-20Martin Stjernholm  if(f == -1) Pike_error("No cast method in object.\n");
6a932b2014-08-18Martin Nilsson  ref_push_string(literal_string_string);
ef8a142004-09-20Martin Stjernholm  apply_low(o, f, 1); stack_pop_keep_top(); }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != PIKE_T_STRING)
ef8a142004-09-20Martin Stjernholm  {
c43e8c2014-08-16Martin Nilsson  if(TYPEOF(sp[-1])==PIKE_T_INT && SUBTYPEOF(sp[-1])==NUMBER_UNDEFINED) Pike_error("Cannot cast this object to string.\n");
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_OBJECT && sp[-1].u.object->prog)
6898c02003-11-14Martin Stjernholm  {
9793b72004-12-18Henrik Grubbström (Grubba)  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN__IS_TYPE);
ef8a142004-09-20Martin Stjernholm  if( f != -1) {
6a932b2014-08-18Martin Nilsson  ref_push_string(literal_string_string);
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, f, 1);
ef8a142004-09-20Martin Stjernholm  f=!UNSAFE_IS_ZERO(sp-1); pop_stack(); if(f) return; }
6898c02003-11-14Martin Stjernholm  }
ef8a142004-09-20Martin Stjernholm  Pike_error("Cast failed, wanted string, got %s\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } }
08261e2008-08-24Stephen R. van den Berg  return;
13670c2015-05-25Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_ARRAY: {
10c6632009-02-06Stephen R. van den Berg  int i, alen;
6898c02003-11-14Martin Stjernholm  struct array *a = sp[-1].u.array; int shift = 0;
10c6632009-02-06Stephen R. van den Berg  alen = a->size;
6898c02003-11-14Martin Stjernholm 
10c6632009-02-06Stephen R. van den Berg  for(i = 0; i<alen; i++) {
e956bb2008-07-11Martin Stjernholm  INT_TYPE val;
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(a->item[i]) != T_INT) {
10c6632009-02-06Stephen R. van den Berg  Pike_error( "Can only cast array(int) to string, item %d is not an integer: %O\n", i, a->item + i);
6898c02003-11-14Martin Stjernholm  }
e956bb2008-07-11Martin Stjernholm  val = a->item[i].u.integer; switch (shift) { /* Trust the compiler to strength reduce this. */ case 0: if ((unsigned INT32) val <= 0xff) break; shift = 1; /* FALL THROUGH */ case 1: if ((unsigned INT32) val <= 0xffff) break;
6898c02003-11-14Martin Stjernholm  shift = 2;
e956bb2008-07-11Martin Stjernholm  /* FALL THROUGH */ case 2: #if SIZEOF_INT_TYPE > 4 if (val < MIN_INT32 || val > MAX_INT32)
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:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to string.\n", get_name_of_type(TYPEOF(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]; format_pike_float (buf, sp[-1].u.float_number); s = make_shared_string(buf); break; }
6898c02003-11-14Martin Stjernholm 
3aff752008-08-26Stephen R. van den Berg  case T_INT:
1d37212010-02-23Stephen R. van den Berg  { INT_TYPE org; char buf[MAX_INT_SPRINTF_LEN];
636bc52014-11-01Martin Nilsson  char *b = buf+sizeof buf-1; unsigned INT_TYPE i;
1d37212010-02-23Stephen R. van den Berg  org = sp[-1].u.integer; *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  SET_SVAL(sp[-1], PIKE_T_STRING, 0, string, s);
6898c02003-11-14Martin Stjernholm }
e7a29a2007-12-28Henrik Grubbström (Grubba) PMOD_EXPORT void o_cast(struct pike_type *type, INT32 run_time_type)
6898c02003-11-14Martin Stjernholm {
017b572011-10-28Henrik Grubbström (Grubba)  if(run_time_type != TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  { if(run_time_type == T_MIXED) return;
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) == T_OBJECT && !sp[-1].u.object->prog) {
ef8a142004-09-20Martin Stjernholm  /* Casting a destructed object should be like casting a zero. */ pop_stack(); push_int (0); }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_OBJECT)
6898c02003-11-14Martin Stjernholm  {
ef8a142004-09-20Martin Stjernholm  struct object *o = sp[-1].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog, LFUN_CAST);
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) 
71e54e2014-08-18Martin Nilsson  if(TYPEOF(sp[-1]) == T_INT && SUBTYPEOF(sp[-1]) == NUMBER_UNDEFINED) Pike_error("Cannot cast this object to %s.\n", get_name_of_type(type->type));
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:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  {
6b336f2015-05-01Martin Nilsson  case T_ARRAY:
6898c02003-11-14Martin Stjernholm  { extern void f_mkmultiset(INT32); f_mkmultiset(1); break; }
6b336f2015-05-01Martin Nilsson  default: Pike_error("Cannot cast %s to multiset.\n", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_MAPPING:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  {
6b336f2015-05-01Martin Nilsson  case T_ARRAY:
6898c02003-11-14Martin Stjernholm  {
6b336f2015-05-01Martin Nilsson  struct array *a=sp[-1].u.array; struct array *b; struct mapping *m; INT32 i; m=allocate_mapping(a->size); /* MAP_SLOTS(a->size) */ push_mapping(m); for (i=0; i<a->size; i++) { if (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", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_ARRAY:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  {
6b336f2015-05-01Martin Nilsson  case T_MAPPING:
6898c02003-11-14Martin Stjernholm  { struct array *a=mapping_to_array(sp[-1].u.mapping); 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", get_name_of_type(TYPEOF(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; switch(TYPEOF(sp[-1])) {
6898c02003-11-14Martin Stjernholm  case T_INT: f=(FLOAT_TYPE)(sp[-1].u.integer); break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_STRING: f = (FLOAT_TYPE)STRTOD_PCHARP(MKPCHARP(sp[-1].u.string->str, sp[-1].u.string->size_shift), 0); free_string(sp[-1].u.string); break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  default:
017b572011-10-28Henrik Grubbström (Grubba)  Pike_error("Cannot cast %s to float.\n", get_name_of_type(TYPEOF(sp[-1])));
6b336f2015-05-01Martin Nilsson  } SET_SVAL(sp[-1], T_FLOAT, 0, float_number, f); break; }
6898c02003-11-14Martin Stjernholm  case T_OBJECT:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  {
6b336f2015-05-01Martin Nilsson  case T_STRING: { struct pike_string *file; INT_TYPE lineno; if(Pike_fp->pc && (file = low_get_line(Pike_fp->pc, Pike_fp->context->prog, &lineno))) { push_string(file); }else{ push_int(0); } /* FIXME: Ought to allow compile_handler to override. */ APPLY_MASTER("cast_to_object",2); return; } case T_FUNCTION: if (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", get_name_of_type(TYPEOF(sp[-1])));
6898c02003-11-14Martin Stjernholm  } break;
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_PROGRAM:
6b336f2015-05-01Martin Nilsson  switch(TYPEOF(sp[-1])) {
6898c02003-11-14Martin Stjernholm  case T_STRING: { struct pike_string *file;
ef24a82012-01-12Henrik Grubbström (Grubba)  INT_TYPE lineno;
6898c02003-11-14Martin Stjernholm  if(Pike_fp->pc &&
fa93a52008-02-28Henrik Grubbström (Grubba)  (file = low_get_line(Pike_fp->pc, Pike_fp->context->prog, &lineno))) {
6898c02003-11-14Martin Stjernholm  push_string(file); }else{ push_int(0); } /* FIXME: Ought to allow compile_handler to override. */ APPLY_MASTER("cast_to_program",2); return; }
6b336f2015-05-01Martin Nilsson 
6898c02003-11-14Martin Stjernholm  case T_FUNCTION:
6b336f2015-05-01Martin Nilsson  { struct program *p=program_from_function(sp-1); if(p) { add_ref(p); pop_stack(); push_program(p); }else{ pop_stack(); push_int(0); } } return;
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", get_name_of_type(TYPEOF(sp[-1])));
6b336f2015-05-01Martin Nilsson  }
6898c02003-11-14Martin Stjernholm  } }
017b572011-10-28Henrik Grubbström (Grubba)  if(run_time_type != TYPEOF(sp[-1]))
6898c02003-11-14Martin Stjernholm  {
6e5a752012-10-27Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1])) { case T_OBJECT: if(sp[-1].u.object->prog)
6898c02003-11-14Martin Stjernholm  {
6e5a752012-10-27Henrik Grubbström (Grubba)  struct object *o = sp[-1].u.object; int f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(sp[-1])].prog, LFUN__IS_TYPE); if( f != -1) {
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); f=!UNSAFE_IS_ZERO(sp-1); pop_stack(); if(f) goto emulated_type_ok; } } break; case T_FUNCTION: /* Check that the function actually is a program. */ if ((run_time_type == T_PROGRAM) && program_from_function(sp-1)) { return; /* No need for further post-processing. */
6898c02003-11-14Martin Stjernholm  }
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), get_name_of_type(TYPEOF(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; struct array *tmp=sp[-2].u.array; 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 struct svalue *save_sp=sp+1; #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 if(save_sp!=sp) Pike_fatal("o_cast left stack droppings.\n"); #endif } END_CYCLIC(); assign_svalue(sp-3,sp-1); pop_stack(); } pop_stack(); } break;
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; struct multiset *tmp=sp[-2].u.multiset; 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 struct svalue *save_sp=sp+1; #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);
b684132014-05-05Per Hedbor  multiset_insert (m, sp - 1);
6898c02003-11-14Martin Stjernholm  pop_stack(); } while ((nodepos = multiset_next (tmp, nodepos)) >= 0); UNSET_ONERROR (uwp); sub_msnode_ref (tmp); } #ifdef PIKE_DEBUG if(save_sp!=sp) Pike_fatal("o_cast left stack droppings.\n"); #endif } END_CYCLIC(); assign_svalue(sp-3,sp-1); pop_stack(); } pop_stack(); } break;
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; struct mapping *tmp=sp[-3].u.mapping; 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 struct svalue *save_sp=sp+1; #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); mapping_insert(m,sp-2,sp-1); pop_n_elems(2); } #ifdef PIKE_DEBUG if(save_sp!=sp) Pike_fatal("o_cast left stack droppings.\n"); #endif } END_CYCLIC(); assign_svalue(sp-4,sp-1); pop_stack(); } pop_n_elems(2); } } } PMOD_EXPORT void f_cast(void) { #ifdef PIKE_DEBUG struct svalue *save_sp=sp;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) != T_TYPE)
6898c02003-11-14Martin Stjernholm  Pike_fatal("Cast expression destroyed stack or left droppings! (Type:%d)\n",
017b572011-10-28Henrik Grubbström (Grubba)  TYPEOF(sp[-2]));
6898c02003-11-14Martin Stjernholm #endif o_cast(sp[-2].u.type, compile_type_to_runtime_type(sp[-2].u.type)); #ifdef PIKE_DEBUG if(save_sp != sp) Pike_fatal("Internal error: o_cast() left droppings on stack.\n"); #endif free_svalue(sp-2); sp[-2]=sp[-1]; sp--; dmalloc_touch_svalue(sp); }
b5955a2006-08-21Henrik Grubbström (Grubba) /* Returns 1 if s is a valid in the type type. */ int low_check_soft_cast(struct svalue *s, struct pike_type *type)
257fcd2006-08-15Henrik Grubbström (Grubba) { loop: switch(type->type) {
b5955a2006-08-21Henrik Grubbström (Grubba)  case T_MIXED: return 1; case T_ZERO:
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*s)) {
b5955a2006-08-21Henrik Grubbström (Grubba)  case PIKE_T_INT: return !s->u.integer; case PIKE_T_FUNCTION:
017b572011-10-28Henrik Grubbström (Grubba)  if (SUBTYPEOF(*s) == FUNCTION_BUILTIN) return 0;
b5955a2006-08-21Henrik Grubbström (Grubba)  /* FALL_THROUGH */ case PIKE_T_OBJECT: return !s->u.object->prog; }
257fcd2006-08-15Henrik Grubbström (Grubba)  return 0;
b5955a2006-08-21Henrik Grubbström (Grubba)  case T_ASSIGN:
257fcd2006-08-15Henrik Grubbström (Grubba)  case PIKE_T_NAME:
a504122013-02-19Henrik Grubbström (Grubba)  case PIKE_T_ATTRIBUTE:
b5955a2006-08-21Henrik Grubbström (Grubba)  type = type->cdr; goto loop;
257fcd2006-08-15Henrik Grubbström (Grubba)  case T_AND:
b5955a2006-08-21Henrik Grubbström (Grubba)  if (!low_check_soft_cast(s, type->car)) return 0; type = type->cdr; goto loop;
257fcd2006-08-15Henrik Grubbström (Grubba)  case T_OR:
b5955a2006-08-21Henrik Grubbström (Grubba)  if (low_check_soft_cast(s, type->car)) return 1; type = type->cdr; goto loop; case T_NOT: return !low_check_soft_cast(s, type->car); }
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(*s) == PIKE_T_INT) && !s->u.integer) return 1; if (TYPEOF(*s) == type->type) {
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); bad_arg_error(NULL, Pike_sp-1, 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: \ i=FUN (sp-2,sp-1); \ pop_n_elems(2); \ push_int(i); \ break; \ default: \ for(i=1;i<args;i++) \ if(! ( FUN (sp-args+i-1, sp-args+i))) \ break; \ pop_n_elems(args); \ push_int(i==args); \ } \
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @decl int(0..1) `!=(mixed arg1, mixed arg2, mixed ... extras) *!
dfceb02003-11-10Martin Stjernholm  *! Inequality test.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Every expression with the @expr{!=@} operator becomes a call to *! this function, i.e. @expr{a!=b@} is the same as *! @expr{predef::`!=(a,b)@}. *! *! This is the inverse of @[`==()]; see that function for further *! details.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! @returns *! Returns @expr{1@} if the test is successful, @expr{0@} *! otherwise.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @seealso *! @[`==()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_ne(INT32 args)
5b4dd31998-02-23Fredrik Hübinette (Hubbe) { f_eq(args);
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) 
33c9582003-11-10Martin Stjernholm #define CALL_OPERATOR(OP, args) do { \
408a1e2004-10-30Martin Stjernholm  struct object *o_ = sp[-args].u.object; \
33c9582003-11-10Martin Stjernholm  int i; \
408a1e2004-10-30Martin Stjernholm  if(!o_->prog) \
33c9582003-11-10Martin Stjernholm  bad_arg_error(lfun_names[OP], sp-args, args, 1, "object", sp-args, \ "Called in destructed object.\n"); \
017b572011-10-28Henrik Grubbström (Grubba)  if((i = FIND_LFUN(o_->prog->inherits[SUBTYPEOF(sp[-args])].prog, \
9793b72004-12-18Henrik Grubbström (Grubba)  OP)) == -1) \
33c9582003-11-10Martin Stjernholm  bad_arg_error(lfun_names[OP], sp-args, args, 1, "object", sp-args, \ "Operator not in object.\n"); \
408a1e2004-10-30Martin Stjernholm  apply_low(o_, i, args-1); \ stack_pop_keep_top(); \
33c9582003-11-10Martin Stjernholm  } while (0)
5267b71995-08-09Fredrik Hübinette (Hubbe) 
56a2612005-09-15Henrik Grubbström (Grubba) /* Helper function for calling ``-operators. * * Assumes o is at Pike_sp[e - args]. * * i is the resolved lfun to call. * * Returns the number of remaining elements on the stack. */ PMOD_EXPORT INT32 low_rop(struct object *o, int i, INT32 e, INT32 args) { if (e == args-1) { /* The object is the last argument. */ ONERROR err; Pike_sp--; SET_ONERROR(err, do_free_object, o); apply_low(o, i, e); CALL_AND_UNSET_ONERROR(err); return args - e; } else { /* Rotate the stack, so that the @[e] first elements come last. */ struct svalue *tmp; if (e*2 < args) { tmp = xalloc(e*sizeof(struct svalue)); memcpy(tmp, Pike_sp-args, e*sizeof(struct svalue)); memmove(Pike_sp-args, (Pike_sp-args)+e, (args-e)*sizeof(struct svalue)); memcpy(Pike_sp-e, tmp, e*sizeof(struct svalue)); } else { tmp = xalloc((args-e)*sizeof(struct svalue)); memcpy(tmp, (Pike_sp-args)+e, (args-e)*sizeof(struct svalue)); memmove(Pike_sp-e, Pike_sp-args, e*sizeof(struct svalue)); memcpy(Pike_sp-args, tmp, (args-e)*sizeof(struct svalue)); } free(tmp); /* Now the stack is: * * -args object with the lfun. * ... * ... other arguments * ... * -e first argument. * ... * -1 last argument before the object. */ #ifdef PIKE_DEBUG
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(Pike_sp[-args]) != T_OBJECT ||
56a2612005-09-15Henrik Grubbström (Grubba)  Pike_sp[-args].u.object != o || !o->prog) { Pike_fatal("low_rop() Lost track of object.\n"); } #endif /* PIKE_DEBUG */ apply_low(o, i, e); args -= e; /* Replace the object with the result. */ assign_svalue(Pike_sp-(args+1), Pike_sp-1); pop_stack(); return args; } }
08b3ec2011-04-08Henrik Grubbström (Grubba) /* Sift down large (absolute) values on the heap. */ static void float_heap_sift_down(struct svalue *svalues, int root, int nelems) { FLOAT_ARG_TYPE val = svalues[root].u.float_number;
a337842011-04-09Henrik Grubbström (Grubba)  FLOAT_ARG_TYPE abs_val = fabs(val);
08b3ec2011-04-08Henrik Grubbström (Grubba)  int child; while ((child = ((root<<1) +1)) < nelems) { int swap = root; FLOAT_ARG_TYPE s_abs_val;
a337842011-04-09Henrik Grubbström (Grubba)  if ((s_abs_val = fabs(svalues[child].u.float_number)) < abs_val) {
08b3ec2011-04-08Henrik Grubbström (Grubba)  swap = child; } else { s_abs_val = abs_val; } child++; if ((child < nelems) &&
a337842011-04-09Henrik Grubbström (Grubba)  (fabs(svalues[child].u.float_number) < s_abs_val)) {
08b3ec2011-04-08Henrik Grubbström (Grubba)  swap = child; } if (swap == root) break; svalues[root] = svalues[swap]; root = swap; } svalues[root].u.float_number = val; }
09cae22003-11-12Martin Stjernholm /*! @decl mixed `+(mixed arg) *! @decl mixed `+(object arg, mixed ... more) *! @decl int `+(int arg, int ... more) *! @decl float `+(float|int arg, float|int ... more) *! @decl string `+(string|float|int arg, string|float|int ... more) *! @decl array `+(array arg, array ... more) *! @decl mapping `+(mapping arg, mapping ... more) *! @decl multiset `+(multiset arg, multiset ... more)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Addition/concatenation. *! *! Every expression with the @expr{+@} operator becomes a call to *! this function, i.e. @expr{a+b@} is the same as *! @expr{predef::`+(a,b)@}. Longer @expr{+@} expressions are *! normally optimized to one call, so e.g. @expr{a+b+c@} becomes *! @expr{predef::`+(a,b,c)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns
dfceb02003-11-10Martin Stjernholm  *! If there's a single argument, that argument is returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
09cae22003-11-12Martin Stjernholm  *! If @[arg] is an object with only one reference and an
dfceb02003-11-10Martin Stjernholm  *! @[lfun::`+=()], that function is called with the rest of the *! arguments, and its result is returned.
5d91362003-04-18Martin Stjernholm  *!
09cae22003-11-12Martin Stjernholm  *! Otherwise, if @[arg] is an object with an @[lfun::`+()], that
dfceb02003-11-10Martin Stjernholm  *! function is called with the rest of the arguments, and its
5d91362003-04-18Martin Stjernholm  *! result is returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if any of the other arguments is an object that has *! an @[lfun::``+()], the first such function is called with the *! arguments leading up to it, and @[`+()] is then called
5d91362003-04-18Martin Stjernholm  *! recursively with the result and the rest of the arguments.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
09cae22003-11-12Martin Stjernholm  *! Otherwise, if @[arg] is @[UNDEFINED] and the other arguments are *! either arrays, mappings or multisets, the first argument is *! ignored and the remaining are added together as described below. *! This is useful primarily when appending to mapping values since *! @expr{m[x] += ({foo})@} will work even if @expr{m[x]@} doesn't *! exist yet.
dfceb02003-11-10Martin Stjernholm  *! *! Otherwise the result depends on the argument types:
09cae22003-11-12Martin Stjernholm  *! @mixed
dfceb02003-11-10Martin Stjernholm  *! @type int|float
09cae22003-11-12Martin Stjernholm  *! The result is the sum of all the arguments. It's a float if *! any argument is a float. *! @type string|int|float *! If any argument is a string, all will be converted to *! strings and concatenated in order to form the result.
dfceb02003-11-10Martin Stjernholm  *! @type array
09cae22003-11-12Martin Stjernholm  *! The array arguments are concatened in order to form the *! result.
dfceb02003-11-10Martin Stjernholm  *! @type mapping
09cae22003-11-12Martin Stjernholm  *! The result is like @[arg] but extended with the entries from *! the other arguments. If the same index (according to *! @[hash_value] and @[`==]) occur in several arguments, the *! value from the last one is used.
dfceb02003-11-10Martin Stjernholm  *! @type multiset
09cae22003-11-12Martin Stjernholm  *! The result is like @[arg] but extended with the entries from *! the other arguments. Subsequences with orderwise equal *! indices (i.e. where @[`<] returns false) are concatenated *! into the result in argument order.
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @note *! In Pike 7.0 and earlier the addition order was unspecified. *!
09cae22003-11-12Martin Stjernholm  *! The treatment of @[UNDEFINED] was new
f09ec92001-02-07Henrik Grubbström (Grubba)  *! in Pike 7.0. *! *! @seealso *! @[`-()], @[lfun::`+()], @[lfun::``+()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_add(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
70b4311998-02-27Fredrik Hübinette (Hubbe)  INT_TYPE e,size;
5267b71995-08-09Fredrik Hübinette (Hubbe)  TYPE_FIELD types;
430fce2004-08-11Henrik Grubbström (Grubba)  tail_recurse:
08b3ec2011-04-08Henrik Grubbström (Grubba)  if (args == 1) return;
5267b71995-08-09Fredrik Hübinette (Hubbe)  types=0;
017b572011-10-28Henrik Grubbström (Grubba)  for(e=-args;e<0;e++) types |= 1<<TYPEOF(sp[e]);
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  switch(types) { default:
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(!args)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06bd612016-01-26Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR("`+", 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }else{ if(types & BIT_OBJECT)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
9793b72004-12-18Henrik Grubbström (Grubba)  struct object *o; struct program *p; int i;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) == T_OBJECT && sp[-args].u.object->prog)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
430fce2004-08-11Henrik Grubbström (Grubba)  /* The first argument is an object. */
9793b72004-12-18Henrik Grubbström (Grubba)  o = sp[-args].u.object;
017b572011-10-28Henrik Grubbström (Grubba)  p = o->prog->inherits[SUBTYPEOF(sp[-args])].prog;
9793b72004-12-18Henrik Grubbström (Grubba)  if(o->refs==1 && (i = FIND_LFUN(p, LFUN_ADD_EQ)) != -1)
ee37801999-02-09Fredrik Hübinette (Hubbe)  {
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, args-1);
0d0bab2003-04-27Martin Stjernholm  stack_pop_keep_top();
ee37801999-02-09Fredrik Hübinette (Hubbe)  return; }
9793b72004-12-18Henrik Grubbström (Grubba)  if((i = FIND_LFUN(p, LFUN_ADD)) != -1)
ee37801999-02-09Fredrik Hübinette (Hubbe)  {
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, args-1);
ee37801999-02-09Fredrik Hübinette (Hubbe)  free_svalue(sp-2); sp[-2]=sp[-1]; sp--;
41e2cb1999-10-24Henrik Grubbström (Grubba)  dmalloc_touch_svalue(sp);
ee37801999-02-09Fredrik Hübinette (Hubbe)  return; }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
33c9582003-11-10Martin Stjernholm 
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  for(e=1;e<args;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) == T_OBJECT &&
9793b72004-12-18Henrik Grubbström (Grubba)  (p = (o = sp[e-args].u.object)->prog) &&
017b572011-10-28Henrik Grubbström (Grubba)  (i = FIND_LFUN(p->inherits[SUBTYPEOF(sp[e-args])].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN_RADD)) != -1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
430fce2004-08-11Henrik Grubbström (Grubba)  /* There's an object with a lfun::``+() at argument @[e]. */
e9cac62005-09-15Henrik Grubbström (Grubba)  if ((args = low_rop(o, i, e, args)) > 1) {
430fce2004-08-11Henrik Grubbström (Grubba)  goto tail_recurse;
e9cac62005-09-15Henrik Grubbström (Grubba)  } return;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  } } } }
07c0731996-06-21Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-args]))
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_PROGRAM: case T_FUNCTION:
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`+", 1, "string|object|int|float|array|mapping|multiset");
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
54db6c1999-03-27Henrik Grubbström (Grubba)  bad_arg_error("`+", sp-args, args, 1, "string|object|int|float|array|mapping|multiset", sp-args, "Incompatible types\n");
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; /* compiler hint */ case BIT_STRING: {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *r;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  PCHARP buf;
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t tmp;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  int max_shift=0; size=0; for(e=-args;e<0;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
3e625c1998-10-11Fredrik Hübinette (Hubbe)  size+=sp[e].u.string->len; if(sp[e].u.string->size_shift > max_shift) max_shift=sp[e].u.string->size_shift;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
66769e1999-11-04Fredrik Hübinette (Hubbe)  if(size == sp[-args].u.string->len) { pop_n_elems(args-1); return; }
7153f92013-05-20Per Hedbor  else if(args == 2 && (size == sp[-1].u.string->len)) { stack_swap(); pop_stack(); return; }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  tmp=sp[-args].u.string->len; r=new_realloc_shared_string(sp[-args].u.string,size,max_shift);
1ab4ac2008-01-26Martin Stjernholm  mark_free_svalue (sp - args);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  buf=MKPCHARP_STR_OFF(r,tmp);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(e=-args+1;e<0;e++) {
9925512013-05-31Per Hedbor  if( sp[e].u.string->len ) { update_flags_for_add( r, sp[e].u.string ); pike_string_cpy(buf,sp[e].u.string); INC_PCHARP(buf,sp[e].u.string->len); }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-args], T_STRING, 0, string, low_end_shared_string(r));
9925512013-05-31Per Hedbor  for(e=-args+1;e<0;e++) free_string(sp[e].u.string);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  sp-=args-1;
8a630c1996-04-13Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; } case BIT_STRING | BIT_INT: case BIT_STRING | BIT_FLOAT: case BIT_STRING | BIT_FLOAT | BIT_INT: {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *r;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  PCHARP buf;
3aff752008-08-26Stephen R. van den Berg  char buffer[MAX_NUM_BUF];
65cae92014-02-24Per Hedbor  int max_shift=0, len;
d67c6d2000-09-22Henrik Grubbström (Grubba) 
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(sp[-args]) != T_STRING) && (TYPEOF(sp[1-args]) != T_STRING)) {
d67c6d2000-09-22Henrik Grubbström (Grubba)  struct svalue *save_sp = sp; /* We need to perform a normal addition first. */ for (e=-args; e < 0; e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(save_sp[e]) == T_STRING)
d67c6d2000-09-22Henrik Grubbström (Grubba)  break; *(sp++) = save_sp[e];
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
d67c6d2000-09-22Henrik Grubbström (Grubba)  } /* Perform the addition. */ f_add(args+e);
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
d67c6d2000-09-22Henrik Grubbström (Grubba)  save_sp[--e] = *(--sp); #ifdef PIKE_DEBUG if (sp != save_sp) {
5aad932002-08-15Marcus Comstedt  Pike_fatal("f_add(): Lost track of stack %p != %p\n", sp, save_sp);
d67c6d2000-09-22Henrik Grubbström (Grubba)  } #endif /* PIKE_DEBUG */ /* Perform the rest of the addition. */ f_add(-e); #ifdef PIKE_DEBUG if (sp != save_sp + 1 + e) {
5aad932002-08-15Marcus Comstedt  Pike_fatal("f_add(): Lost track of stack (2) %p != %p\n",
d67c6d2000-09-22Henrik Grubbström (Grubba)  sp, save_sp + 1 + e); } #endif /* PIKE_DEBUG */ /* Adjust the stack. */ save_sp[-args] = sp[-1]; sp = save_sp + 1 - args; return; } else { e = -args; }
561e752008-05-21Martin Stjernholm 
5267b71995-08-09Fredrik Hübinette (Hubbe)  size=0; for(e=-args;e<0;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[e]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_STRING: size+=sp[e].u.string->len;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  if(sp[e].u.string->size_shift > max_shift) max_shift=sp[e].u.string->size_shift;
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_INT:
561e752008-05-21Martin Stjernholm  size += MAX_INT_SPRINTF_LEN;
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_FLOAT:
561e752008-05-21Martin Stjernholm  size += MAX_FLOAT_SPRINTF_LEN;
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; } }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  r=begin_wide_shared_string(size,max_shift);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  buf=MKPCHARP_STR(r);
5267b71995-08-09Fredrik Hübinette (Hubbe)  size=0;
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  for(e=-args;e<0;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[e]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_STRING:
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  pike_string_cpy(buf,sp[e].u.string); INC_PCHARP(buf,sp[e].u.string->len);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_INT:
01f9cc2003-11-13Martin Stjernholm  sprintf(buffer,"%"PRINTPIKEINT"d",sp[e].u.integer);
561e752008-05-21Martin Stjernholm #ifdef PIKE_DEBUG if (strlen (buffer) > MAX_INT_SPRINTF_LEN) Pike_fatal ("Formatted integer %s is %"PRINTSIZET"u, " "longer than assumed max %"PRINTSIZET"u.\n", buffer, strlen (buffer), MAX_INT_SPRINTF_LEN); #endif
3e625c1998-10-11Fredrik Hübinette (Hubbe)  goto append_buffer;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT:
3aff752008-08-26Stephen R. van den Berg  sprintf(buffer,"%.*"PRINTPIKEFLOAT"g",
9c04092009-08-05Martin Stjernholm  PIKEFLOAT_DIG, sp[e].u.float_number);
4844192009-06-30Martin Stjernholm  /* See comment for T_FLOAT in o_cast_to_string. */
b13bc32009-06-30Martin Stjernholm  if (!strchr (buffer, '.') && !strchr (buffer, 'e'))
4844192009-06-30Martin Stjernholm  strcat (buffer, ".0");
561e752008-05-21Martin Stjernholm #ifdef PIKE_DEBUG if (strlen (buffer) > MAX_FLOAT_SPRINTF_LEN) Pike_fatal ("Formatted float %s is %"PRINTSIZET"u, " "longer than assumed max %"PRINTSIZET"u.\n", buffer, strlen (buffer), MAX_FLOAT_SPRINTF_LEN); #endif
3e625c1998-10-11Fredrik Hübinette (Hubbe)  append_buffer:
65cae92014-02-24Per Hedbor  len = strlen(buffer);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  switch(max_shift) {
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  case 0:
65cae92014-02-24Per Hedbor  convert_0_to_0((p_wchar0 *)buf.ptr,buffer,len);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break; case 1:
65cae92014-02-24Per Hedbor  convert_0_to_1((p_wchar1 *)buf.ptr,(p_wchar0 *)buffer,len);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break; case 2:
65cae92014-02-24Per Hedbor  convert_0_to_2((p_wchar2 *)buf.ptr,(p_wchar0 *)buffer,len);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  }
65cae92014-02-24Per Hedbor  INC_PCHARP(buf,len);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
4949682001-09-25Henrik Grubbström (Grubba)  r = realloc_unlinked_string(r, SUBTRACT_PCHARP(buf, MKPCHARP_STR(r))); r = low_end_shared_string(r);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(r); break; } case BIT_INT:
f306632012-12-31Arne Goedeke  { int of = 0;
fda0de1999-10-08Fredrik Noring  size = 0; for(e = -args; e < 0; e++) {
fe62692014-01-11Arne Goedeke  if (DO_INT_TYPE_ADD_OVERFLOW(size, sp[e].u.integer, &size)) { convert_svalue_to_bignum(sp-args); f_add(args); return; }
fda0de1999-10-08Fredrik Noring  }
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  sp-=args; push_int(size);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
f306632012-12-31Arne Goedeke  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  case BIT_FLOAT:
08b3ec2011-04-08Henrik Grubbström (Grubba)  if (args > 2) { /* Attempt to minimize the accumulated summation error * by adding the smallest (absolute) values first. *
8496b22011-04-09Henrik Grubbström (Grubba)  * Large accumulated errors can occur eg when the number * of values to add is of the same order as the largest * number representable by the mantissa alone. ie when * the sum differs by an order of magnitude from a * typical term.
08b3ec2011-04-08Henrik Grubbström (Grubba)  */ /* Heapify */ for(e = args>>1; e--;) { float_heap_sift_down(Pike_sp-args, e, args); } while (args > 2) {
8496b22011-04-09Henrik Grubbström (Grubba)  /* Pop the smallest element from the heap. */
08b3ec2011-04-08Henrik Grubbström (Grubba)  FLOAT_ARG_TYPE top = Pike_sp[-args].u.float_number;
416a452012-06-22Per Hedbor  Pike_sp[-args] = Pike_sp[-1]; Pike_sp--;
08b3ec2011-04-08Henrik Grubbström (Grubba)  args--; float_heap_sift_down(Pike_sp-args, 0, args);
8496b22011-04-09Henrik Grubbström (Grubba)  /* And add it to the second smallest. */
08b3ec2011-04-08Henrik Grubbström (Grubba)  Pike_sp[-args].u.float_number += top; float_heap_sift_down(Pike_sp-args, 0, args); } } sp[-2].u.float_number += sp[-1].u.float_number; sp--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
482fb51999-03-12Per Hedbor  case BIT_FLOAT|BIT_INT:
bce86c1996-02-25Fredrik Hübinette (Hubbe)  {
08b3ec2011-04-08Henrik Grubbström (Grubba)  /* For improved precision; partition the values * into floats followed by ints, so that we * can add the integers exactly. */ int i = args-1; e = 0; while (e < i) { for(;e < i; i--) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[i-args]) == T_FLOAT) break;
08b3ec2011-04-08Henrik Grubbström (Grubba)  } for(;e < i; e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[e-args]) == T_INT) break;
08b3ec2011-04-08Henrik Grubbström (Grubba)  } if (e < i) { /* Swap */ struct svalue sval = sp[e-args]; sp[e-args] = sp[i-args]; sp[i-args] = sval;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  } }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[e-args]) == T_FLOAT) e++;
08b3ec2011-04-08Henrik Grubbström (Grubba)  /* Sum the integers. */ if (args - e > 1) { f_add(args-e); } args = e+1; o_cast(float_type_string, PIKE_T_FLOAT); /* Now all the values should be floats. */ goto tail_recurse;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  }
09cae22003-11-12Martin Stjernholm #define ADD_WITH_UNDEFINED(TYPE, T_TYPEID, ADD_FUNC, PUSH_FUNC) do { \ int e; \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) == T_INT) { \
09cae22003-11-12Martin Stjernholm  if(IS_UNDEFINED(sp-args)) \ { \ struct TYPE *x; \ \ for(e=1;e<args;e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_TYPEID) \
09cae22003-11-12Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR("`+", e+1, #TYPE); \ \ x = ADD_FUNC(sp-args+1,args-1); \ pop_n_elems(args); \ PUSH_FUNC(x); \ return; \ } \ \ for(e=1;e<args;e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[e-args]) != T_INT) \
09cae22003-11-12Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR("`+", e+1, "int"); \ } \ \ else { \ for(e=1;e<args;e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[e-args]) != T_TYPEID) \
09cae22003-11-12Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR("`+", e+1, #TYPE); \ } \ \ DO_IF_DEBUG (Pike_fatal ("Shouldn't be reached.\n")); \
14f5d82009-08-12Henrik Grubbström (Grubba)  break; \
09cae22003-11-12Martin Stjernholm  } while (0)
ee37801999-02-09Fredrik Hübinette (Hubbe) 
09cae22003-11-12Martin Stjernholm #define ADD(TYPE, ADD_FUNC, PUSH_FUNC) do { \ struct TYPE *x = ADD_FUNC (sp - args, args); \ pop_n_elems (args); \ PUSH_FUNC (x); \ return; \ } while (0) case BIT_ARRAY|BIT_INT: ADD_WITH_UNDEFINED (array, T_ARRAY, add_arrays, push_array);
7c15fa2015-04-22Henrik Grubbström (Grubba)  break;
13670c2015-05-25Martin Nilsson 
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:
09cae22003-11-12Martin Stjernholm  ADD_WITH_UNDEFINED (mapping, T_MAPPING, add_mappings, push_mapping);
7c15fa2015-04-22Henrik Grubbström (Grubba)  break;
482fb51999-03-12Per Hedbor 
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: ADD_WITH_UNDEFINED (multiset, T_MULTISET, add_multisets, push_multiset);
7c15fa2015-04-22Henrik Grubbström (Grubba)  break;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
06983f1996-09-22Fredrik Hübinette (Hubbe)  case BIT_MULTISET:
09cae22003-11-12Martin Stjernholm  ADD (multiset, add_multisets, push_multiset);
7c15fa2015-04-22Henrik Grubbström (Grubba)  break;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
09cae22003-11-12Martin Stjernholm #undef ADD_WITH_UNDEFINED #undef ADD
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) static int generate_sum(node *n) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
204a5a2004-08-24Henrik Grubbström (Grubba)  node **first_arg, **second_arg, **third_arg;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  switch(count_args(CDR(n))) {
204a5a2004-08-24Henrik Grubbström (Grubba)  case 0: return 0;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  case 1: do_docode(CDR(n),0); return 1; case 2:
a2b70a2000-04-30Fredrik Hübinette (Hubbe)  first_arg=my_get_arg(&_CDR(n), 0); second_arg=my_get_arg(&_CDR(n), 1);
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); push_type(T_STRING);
a0c96c2007-03-20Henrik Grubbström (Grubba)  free_type(n->type); n->type = pop_unfinished_type(); } } #endif /* 0 */
6930181996-02-25Fredrik Hübinette (Hubbe)  return 0; }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) static int generate_comparison(node *n) { if(count_args(CDR(n))==2) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
4c573c1996-08-03Fredrik Hübinette (Hubbe)  if(do_docode(CDR(n),DO_NOT_COPY) != 2)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Count args was wrong in generate_comparison.\n");
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  if(CAR(n)->u.sval.u.efun->function == f_eq)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_EQ);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_ne)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_NE);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_lt)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_LT);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_le)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_LE);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_gt)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_GT);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else if(CAR(n)->u.sval.u.efun->function == f_ge)
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_GE);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  else
80ee912006-03-25Henrik Grubbström (Grubba)  Pike_fatal("Couldn't generate comparison!\n" "efun->function: %p\n" "f_eq: %p\n" "f_ne: %p\n" "f_lt: %p\n" "f_le: %p\n" "f_gt: %p\n" "f_ge: %p\n", CAR(n)->u.sval.u.efun->function, f_eq, f_ne, f_lt, f_le, f_gt, f_ge);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
be478c1997-08-30Henrik Grubbström (Grubba) static int float_promote(void)
bce86c1996-02-25Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) == T_INT && TYPEOF(sp[-1]) == T_FLOAT)
bce86c1996-02-25Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_FLOAT, 0, float_number, (FLOAT_TYPE)sp[-2].u.integer);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 1;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  }
017b572011-10-28Henrik Grubbström (Grubba)  else if(TYPEOF(sp[-1]) == T_INT && TYPEOF(sp[-2]) == T_FLOAT)
bce86c1996-02-25Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_FLOAT, 0, float_number, (FLOAT_TYPE)sp[-1].u.integer);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 1; }
e924491999-12-14Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if(is_bignum_object_in_svalue(sp-2) && TYPEOF(sp[-1]) == T_FLOAT)
e924491999-12-14Fredrik Hübinette (Hubbe)  { stack_swap();
b103b32001-02-20Henrik Grubbström (Grubba)  ref_push_type_value(float_type_string);
e924491999-12-14Fredrik Hübinette (Hubbe)  stack_swap(); f_cast(); stack_swap(); return 1; }
017b572011-10-28Henrik Grubbström (Grubba)  else if(is_bignum_object_in_svalue(sp-1) && TYPEOF(sp[-2]) == T_FLOAT)
e924491999-12-14Fredrik Hübinette (Hubbe)  {
b103b32001-02-20Henrik Grubbström (Grubba)  ref_push_type_value(float_type_string);
e924491999-12-14Fredrik Hübinette (Hubbe)  stack_swap(); f_cast(); return 1; }
0311712013-06-17Martin Nilsson 
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  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) 
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) == T_OBJECT &&
9793b72004-12-18Henrik Grubbström (Grubba)  (p = (o = sp[-2].u.object)->prog) &&
017b572011-10-28Henrik Grubbström (Grubba)  (i = FIND_LFUN(p->inherits[SUBTYPEOF(sp[-2])].prog, left)) != -1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  free_svalue(sp-2); sp[-2]=sp[-1]; sp--;
41e2cb1999-10-24Henrik Grubbström (Grubba)  dmalloc_touch_svalue(sp);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 1;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_OBJECT &&
9793b72004-12-18Henrik Grubbström (Grubba)  (p = (o = sp[-1].u.object)->prog) &&
017b572011-10-28Henrik Grubbström (Grubba)  (i = FIND_LFUN(p->inherits[SUBTYPEOF(sp[-1])].prog, right)) != -1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  { push_svalue(sp-2);
9793b72004-12-18Henrik Grubbström (Grubba)  apply_low(o, i, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  free_svalue(sp-3); sp[-3]=sp[-1]; sp--;
41e2cb1999-10-24Henrik Grubbström (Grubba)  dmalloc_touch_svalue(sp);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  pop_stack(); return 1; } return 0;
bce86c1996-02-25Fredrik Hübinette (Hubbe) }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
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) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-2]) != TYPEOF(sp[-1]) && !float_promote())
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  { if(call_lfun(LFUN_SUBTRACT, LFUN_RSUBTRACT)) return;
aa17e32000-04-12Mirar (Pontus Hagland) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-2]) == T_MAPPING) switch (TYPEOF(sp[-1]))
aa17e32000-04-12Mirar (Pontus Hagland)  { case T_ARRAY: { struct mapping *m; m=merge_mapping_array_unordered(sp[-2].u.mapping, sp[-1].u.array, PIKE_ARRAY_OP_SUB); pop_n_elems(2); push_mapping(m); return; } case T_MULTISET: { struct mapping *m;
5b15bb2001-12-10Martin Stjernholm  int got_cmp_less = !!multiset_get_cmp_less (sp[-1].u.multiset); struct array *ind = multiset_indices (sp[-1].u.multiset); pop_stack(); push_array (ind); if (got_cmp_less) m=merge_mapping_array_unordered(sp[-2].u.mapping, sp[-1].u.array, PIKE_ARRAY_OP_SUB); else m=merge_mapping_array_ordered(sp[-2].u.mapping, sp[-1].u.array, PIKE_ARRAY_OP_SUB);
aa17e32000-04-12Mirar (Pontus Hagland)  pop_n_elems(2); push_mapping(m); return; } }
017b572011-10-28Henrik Grubbström (Grubba)  bad_arg_error("`-", sp-2, 2, 2, get_name_of_type(TYPEOF(sp[-2])),
54db6c1999-03-27Henrik Grubbström (Grubba)  sp-1, "Subtract on different types.\n");
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_SUBTRACT,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_ARRAY: { struct array *a; check_array_for_destruct(sp[-2].u.array); check_array_for_destruct(sp[-1].u.array); a = subtract_arrays(sp[-2].u.array, sp[-1].u.array); pop_n_elems(2); push_array(a); return; } case T_MAPPING: { struct mapping *m;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping,PIKE_ARRAY_OP_SUB);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_mapping(m); return; }
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct multiset *l;
d05ad72016-12-30Martin Nilsson  l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_SUB);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2);
06983f1996-09-22Fredrik Hübinette (Hubbe)  push_multiset(l);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; } case T_FLOAT: sp--; sp[-1].u.float_number -= sp[0].u.float_number; return; case T_INT:
ff0d461999-10-15Fredrik Noring  if(INT_TYPE_SUB_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer)) { convert_stack_top_to_bignum(); f_minus(2); return; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], PIKE_T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer - sp[0].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; case T_STRING: {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s,*ret;
5267b71995-08-09Fredrik Hübinette (Hubbe)  s=make_shared_string("");
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  ret=string_replace(sp[-2].u.string,sp[-1].u.string,s); free_string(sp[-2].u.string);
5267b71995-08-09Fredrik Hübinette (Hubbe)  free_string(sp[-1].u.string); free_string(s);
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  sp[-2].u.string=ret; sp--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
33c9582003-11-10Martin Stjernholm  /* FIXME: Support types? */
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
54db6c1999-03-27Henrik Grubbström (Grubba)  { int args = 2;
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 *! that match any in @[arg2] (according to @[`==] and, in the *! case of mappings, @[hash_value]).
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @note *! In Pike 7.0 and earlier the subtraction order was unspecified. *! *! @seealso *! @[`+()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_minus(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
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;
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  struct svalue *s=sp-args;
8496b22011-04-09Henrik Grubbström (Grubba) 
017b572011-10-28Henrik Grubbström (Grubba)  for(e=-args;e<0;e++) types |= 1<<TYPEOF(sp[e]);
8496b22011-04-09Henrik Grubbström (Grubba)  if ((types | BIT_INT | BIT_FLOAT) == (BIT_INT | BIT_FLOAT)) {
5c22db2011-04-09Henrik Grubbström (Grubba)  INT32 carry = 0; if (types == BIT_INT) { f_add(args-1); o_subtract(); break; }
8496b22011-04-09Henrik Grubbström (Grubba)  /* Take advantage of the precision control in f_add(). */
5c22db2011-04-09Henrik Grubbström (Grubba)  for(e = 1; e < args; e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(s[e]) == PIKE_T_INT) {
5c22db2011-04-09Henrik Grubbström (Grubba)  INT_TYPE val = s[e].u.integer; if (val >= -0x7fffffff) { s[e].u.integer = -val; } else { /* Protect against negative overflow. */ s[e].u.integer = ~val; carry++; } } else { s[e].u.float_number = -s[e].u.float_number; } } if (carry) { push_int(carry); args++; } f_add(args);
8496b22011-04-09Henrik Grubbström (Grubba)  break; }
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(); } assign_svalue(s,sp-1); pop_n_elems(sp-s-1); }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  } } static int generate_minus(node *n)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  switch(count_args(CDR(n))) { case 1: do_docode(CDR(n),DO_NOT_COPY);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_NEGATE);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; case 2:
5e44422001-02-25Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_SUBTRACT);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_and(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
18678b2016-12-30Martin Nilsson  if(UNLIKELY(TYPEOF(sp[-1]) != TYPEOF(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;
017b572011-10-28Henrik Grubbström (Grubba)  else if (((TYPEOF(sp[-1]) == T_TYPE) || (TYPEOF(sp[-1]) == T_PROGRAM) || (TYPEOF(sp[-1]) == T_FUNCTION)) && ((TYPEOF(sp[-2]) == T_TYPE) || (TYPEOF(sp[-2]) == T_PROGRAM) || (TYPEOF(sp[-2]) == T_FUNCTION)))
aa17e32000-04-12Mirar (Pontus Hagland)  {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-2]) != T_TYPE)
aa17e32000-04-12Mirar (Pontus Hagland)  { struct program *p = program_from_svalue(sp - 2); if (!p) { int args = 2;
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);
aa17e32000-04-12Mirar (Pontus Hagland)  free_svalue(sp - 2);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_TYPE)
aa17e32000-04-12Mirar (Pontus Hagland)  { struct program *p = program_from_svalue(sp - 1);
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);
aa17e32000-04-12Mirar (Pontus Hagland)  free_svalue(sp - 1);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
13670c2015-05-25Martin Nilsson  }
017b572011-10-28Henrik Grubbström (Grubba)  else if (TYPEOF(sp[-2]) == T_MAPPING) switch (TYPEOF(sp[-1]))
aa17e32000-04-12Mirar (Pontus Hagland)  { case T_ARRAY: { struct mapping *m; m=merge_mapping_array_unordered(sp[-2].u.mapping, sp[-1].u.array, PIKE_ARRAY_OP_AND); pop_n_elems(2); push_mapping(m); return; } case T_MULTISET: { struct mapping *m;
5b15bb2001-12-10Martin Stjernholm  int got_cmp_less = !!multiset_get_cmp_less (sp[-1].u.multiset); struct array *ind = multiset_indices (sp[-1].u.multiset); pop_stack(); push_array (ind); if (got_cmp_less) m=merge_mapping_array_unordered(sp[-2].u.mapping, sp[-1].u.array, PIKE_ARRAY_OP_AND); else m=merge_mapping_array_ordered(sp[-2].u.mapping, sp[-1].u.array, PIKE_ARRAY_OP_AND);
aa17e32000-04-12Mirar (Pontus Hagland)  pop_n_elems(2); push_mapping(m); return; }
eed2da2001-06-11Henrik Grubbström (Grubba)  default: { int args = 2;
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;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`&", 2, get_name_of_type(TYPEOF(sp[-2])));
aa17e32000-04-12Mirar (Pontus Hagland)  }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_AND,2); break;
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT: sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], PIKE_T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer & sp[0].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING: { struct mapping *m;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping, PIKE_ARRAY_OP_AND);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_mapping(m); return; }
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct multiset *l;
d05ad72016-12-30Martin Nilsson  l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_AND);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2);
06983f1996-09-22Fredrik Hübinette (Hubbe)  push_multiset(l);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_ARRAY: { struct array *a; a=and_arrays(sp[-2].u.array, sp[-1].u.array); pop_n_elems(2); push_array(a); return; }
fc0bb51997-02-13Niels Möller 
3db0d21999-12-13Henrik Grubbström (Grubba)  case T_TYPE: {
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *t; t = and_pike_types(sp[-2].u.type, sp[-1].u.type);
3db0d21999-12-13Henrik Grubbström (Grubba)  pop_n_elems(2);
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(t);
3db0d21999-12-13Henrik Grubbström (Grubba)  return; }
dc7d491999-12-15Henrik Grubbström (Grubba)  case T_FUNCTION: case T_PROGRAM: { struct program *p;
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *a; struct pike_type *b; struct pike_type *t;
dc7d491999-12-15Henrik Grubbström (Grubba)  p = program_from_svalue(sp - 2); if (!p) { int args = 2;
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(); p = program_from_svalue(sp - 1); 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  \ len = sp[-2].u.string->len; \ if (len != sp[-1].u.string->len) \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  PIKE_ERROR("`" #OP, "Bitwise "STROP \ " on strings of different lengths.\n", sp, 2); \
a2a5812013-08-25Arne Goedeke  if(!sp[-2].u.string->size_shift && !sp[-1].u.string->size_shift) \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  { \ s = begin_shared_string(len); \ for (i=0; i<len; i++) \
a2a5812013-08-25Arne Goedeke  s->str[i] = sp[-2].u.string->str[i] OP sp[-1].u.string->str[i]; \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  }else{ \ s = begin_wide_shared_string(len, \
a2a5812013-08-25Arne Goedeke  MAXIMUM(sp[-2].u.string->size_shift, \ sp[-1].u.string->size_shift)); \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  for (i=0; i<len; i++) \
a2a5812013-08-25Arne Goedeke  low_set_index(s,i,index_shared_string(sp[-2].u.string,i) OP \ index_shared_string(sp[-1].u.string,i)); \
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  } \ pop_n_elems(2); \
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:
fd95012002-12-12Martin Nilsson  PIKE_ERROR("`&", "Bitwise AND on illegal type.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
3c04e81997-03-13Fredrik Hübinette (Hubbe) /* This function is used to speed up or/xor/and on * arrays multisets and mappings. This is done by * calling the operator for each pair of arguments * first, then recursively doing the same on the * results until only one value remains. */
adbb781998-09-18Fredrik Hübinette (Hubbe) static void r_speedup(INT32 args, void (*func)(void)) { struct svalue tmp; ONERROR err; switch(args) { case 3: func(); case 2: func(); case 1: return; default: r_speedup((args+1)>>1,func);
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
adbb781998-09-18Fredrik Hübinette (Hubbe)  tmp=*--sp; SET_ONERROR(err,do_free_svalue,&tmp); r_speedup(args>>1,func); UNSET_ONERROR(err); sp++[0]=tmp; func(); } }
3c04e81997-03-13Fredrik Hübinette (Hubbe) static void speedup(INT32 args, void (*func)(void)) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-args]))
3c04e81997-03-13Fredrik Hübinette (Hubbe)  {
c2769b1999-10-01Fredrik Hübinette (Hubbe)  /* Binary balanced tree method for types where * a op b may or may not be equal to b op a */ case T_ARRAY:
adbb781998-09-18Fredrik Hübinette (Hubbe)  case T_MAPPING: r_speedup(args,func); return;
3c04e81997-03-13Fredrik Hübinette (Hubbe) 
adbb781998-09-18Fredrik Hübinette (Hubbe)  default: while(--args > 0) func();
3c04e81997-03-13Fredrik Hübinette (Hubbe)  } }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @decl mixed `&(mixed arg1)
dfceb02003-11-10Martin Stjernholm  *! @decl mixed `&(mixed arg1, mixed arg2, mixed ... extras)
f09ec92001-02-07Henrik Grubbström (Grubba)  *! @decl mixed `&(object arg1, mixed arg2) *! @decl mixed `&(mixed arg1, object arg2) *! @decl int `&(int arg1, int arg2)
dfceb02003-11-10Martin Stjernholm  *! @decl string `&(string arg1, string arg2)
f09ec92001-02-07Henrik Grubbström (Grubba)  *! @decl array `&(array arg1, array arg2) *! @decl mapping `&(mapping arg1, mapping arg2) *! @decl mapping `&(mapping arg1, array arg2) *! @decl mapping `&(mapping arg1, multiset arg2)
dfceb02003-11-10Martin Stjernholm  *! @decl multiset `&(multiset arg1, multiset arg2) *! @decl type `&(type|program arg1, type|program arg2) *! *! Bitwise and/intersection.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Every expression with the @expr{&@} operator becomes a call to *! this function, i.e. @expr{a&b@} is the same as *! @expr{predef::`&(a,b)@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
dfceb02003-11-10Martin Stjernholm  *! If there's a single argument, that argument is returned.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! If there are more than two arguments the result is:
f79bd82003-04-01Martin Nilsson  *! @expr{`&(`&(@[arg1], @[arg2]), @@@[extras])@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg1] is an object with an @[lfun::`&()], that *! function is called with @[arg2] as argument, and its result is *! returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg2] is an object with an @[lfun::``&()], that *! function is called with @[arg1] as argument, and its result is *! returned. *! *! Otherwise the result depends on the argument types:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type int
dfceb02003-11-10Martin Stjernholm  *! Bitwise and of @[arg1] and @[arg2].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type string
dfceb02003-11-10Martin Stjernholm  *! The result is a string where each character is the bitwise *! and of the characters in the same position in @[arg1] and *! @[arg2]. The arguments must be strings of the same length. *! @type array|mapping|multiset *! The result is like @[arg1] but only with the *! elements/indices that match any in @[arg2] (according to *! @[`==] and, in the case of mappings, @[hash_value]). *! @type type|program *! Type intersection of @[arg1] and @[arg2].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! @seealso *! @[`|()], @[lfun::`&()], @[lfun::``&()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_and(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
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) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != TYPEOF(sp[-2]))
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
dc7d491999-12-15Henrik Grubbström (Grubba)  if(call_lfun(LFUN_OR, LFUN_ROR)) {
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return;
017b572011-10-28Henrik Grubbström (Grubba)  } else if (((TYPEOF(sp[-1]) == T_TYPE) || (TYPEOF(sp[-1]) == T_PROGRAM) || (TYPEOF(sp[-1]) == T_FUNCTION)) && ((TYPEOF(sp[-2]) == T_TYPE) || (TYPEOF(sp[-2]) == T_PROGRAM) || (TYPEOF(sp[-2]) == T_FUNCTION))) { if (TYPEOF(sp[-2]) != T_TYPE) {
dc7d491999-12-15Henrik Grubbström (Grubba)  struct program *p = program_from_svalue(sp - 2); if (!p) { int args = 2;
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)  free_svalue(sp - 2);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_TYPE) {
dc7d491999-12-15Henrik Grubbström (Grubba)  struct program *p = program_from_svalue(sp - 1); if (!p) { int args = 2;
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)  free_svalue(sp - 1);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  } } else {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`|", 2, get_name_of_type(TYPEOF(sp[-2])));
54db6c1999-03-27Henrik Grubbström (Grubba)  }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_OR,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT: sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer | sp[0].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING: { struct mapping *m;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping, PIKE_ARRAY_OP_OR);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_mapping(m); return; }
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct multiset *l;
d05ad72016-12-30Martin Nilsson  l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_OR_LEFT);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2);
06983f1996-09-22Fredrik Hübinette (Hubbe)  push_multiset(l);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_ARRAY: {
5768c22009-09-07Henrik Grubbström (Grubba)  if (sp[-1].u.array->size == 1) { /* Common case (typically the |= operator). */ int i = array_search(sp[-2].u.array, sp[-1].u.array->item, 0); if (i == -1) { f_add(2); } else { pop_stack(); } } else if ((sp[-2].u.array == sp[-1].u.array) && (sp[-1].u.array->refs == 2)) { /* Not common, but easy to detect... */ pop_stack(); } else { struct array *a; a=merge_array_with_order(sp[-2].u.array, sp[-1].u.array, PIKE_ARRAY_OP_OR_LEFT); pop_n_elems(2); push_array(a); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
3db0d21999-12-13Henrik Grubbström (Grubba)  case T_TYPE: {
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *t; t = or_pike_types(sp[-2].u.type, sp[-1].u.type, 0);
3db0d21999-12-13Henrik Grubbström (Grubba)  pop_n_elems(2);
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(t);
3db0d21999-12-13Henrik Grubbström (Grubba)  return; }
dc7d491999-12-15Henrik Grubbström (Grubba)  case T_FUNCTION: case T_PROGRAM: { struct program *p;
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *a; struct pike_type *b; struct pike_type *t;
dc7d491999-12-15Henrik Grubbström (Grubba)  p = program_from_svalue(sp - 2); if (!p) { int args = 2;
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(); p = program_from_svalue(sp - 1); 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:
fd95012002-12-12Martin Nilsson  PIKE_ERROR("`|", "Bitwise OR on illegal type.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
b90e552001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `|(mixed arg1)
dfceb02003-11-10Martin Stjernholm  *! @decl mixed `|(mixed arg1, mixed arg2, mixed ... extras)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mixed `|(object arg1, mixed arg2) *! @decl mixed `|(mixed arg1, object arg2) *! @decl int `|(int arg1, int arg2)
dfceb02003-11-10Martin Stjernholm  *! @decl string `|(string arg1, string arg2) *! @decl array `|(array arg1, array arg2)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mapping `|(mapping arg1, mapping arg2) *! @decl multiset `|(multiset arg1, multiset arg2) *! @decl type `|(program|type arg1, program|type arg2) *!
dfceb02003-11-10Martin Stjernholm  *! Bitwise or/union. *! *! Every expression with the @expr{|@} operator becomes a call to *! this function, i.e. @expr{a|b@} is the same as *! @expr{predef::`|(a,b)@}.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
dfceb02003-11-10Martin Stjernholm  *! If there's a single argument, that argument is returned.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! If there are more than two arguments, the result is:
f79bd82003-04-01Martin Nilsson  *! @expr{`|(`|(@[arg1], @[arg2]), @@@[extras])@}.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg1] is an object with an @[lfun::`|()], that *! function is called with @[arg2] as argument, and its result is *! returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg2] is an object with an @[lfun::``|()], that *! function is called with @[arg1] as argument, and its result is *! returned. *! *! Otherwise the result depends on the argument types:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
dfceb02003-11-10Martin Stjernholm  *! @type int *! Bitwise or of @[arg1] and @[arg2]. *! @type string *! The result is a string where each character is the bitwise *! or of the characters in the same position in @[arg1] and *! @[arg2]. The arguments must be strings of the same length. *! @type array *! The result is an array with the elements in @[arg1] *! concatenated with those in @[arg2] that doesn't occur in *! @[arg1] (according to @[`==]). The order between the *! elements that come from the same argument is kept. *! *! Every element in @[arg1] is only matched once against an *! element in @[arg2], so if @[arg2] contains several elements *! that are equal to each other and are more than their *! counterparts in @[arg1], the rightmost remaining elements in *! @[arg2] are kept. *! @type mapping *! The result is like @[arg1] but extended with the entries *! from @[arg2]. If the same index (according to @[hash_value] *! and @[`==]) occur in both, the value from @[arg2] is used. *! @type multiset *! The result is like @[arg1] but extended with the entries in *! @[arg2] that doesn't already occur in @[arg1] (according to *! @[`==]). Subsequences with orderwise equal entries (i.e. *! where @[`<] returns false) are handled just like the array *! case above. *! @type type|program *! Type union of @[arg1] and @[arg2].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
b90e552001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[`&()], @[lfun::`|()], @[lfun::``|()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_or(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
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) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != TYPEOF(sp[-2]))
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
dc7d491999-12-15Henrik Grubbström (Grubba)  if(call_lfun(LFUN_XOR, LFUN_RXOR)) {
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return;
017b572011-10-28Henrik Grubbström (Grubba)  } else if (((TYPEOF(sp[-1]) == T_TYPE) || (TYPEOF(sp[-1]) == T_PROGRAM) || (TYPEOF(sp[-1]) == T_FUNCTION)) && ((TYPEOF(sp[-2]) == T_TYPE) || (TYPEOF(sp[-2]) == T_PROGRAM) || (TYPEOF(sp[-2]) == T_FUNCTION))) { if (TYPEOF(sp[-2]) != T_TYPE) {
dc7d491999-12-15Henrik Grubbström (Grubba)  struct program *p = program_from_svalue(sp - 2); if (!p) { int args = 2;
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)  free_svalue(sp - 2);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_TYPE) {
dc7d491999-12-15Henrik Grubbström (Grubba)  struct program *p = program_from_svalue(sp - 1); if (!p) { int args = 2;
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)  free_svalue(sp - 1);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_TYPE, 0, type, pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  } } else {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 2;
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`^", 2, get_name_of_type(TYPEOF(sp[-2])));
54db6c1999-03-27Henrik Grubbström (Grubba)  }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_XOR,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT: sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer ^ sp[0].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING: { struct mapping *m;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  m=merge_mappings(sp[-2].u.mapping, sp[-1].u.mapping, PIKE_ARRAY_OP_XOR);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_mapping(m); return; }
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct multiset *l;
d05ad72016-12-30Martin Nilsson  l=merge_multisets(sp[-2].u.multiset, sp[-1].u.multiset, PIKE_ARRAY_OP_XOR);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(2);
06983f1996-09-22Fredrik Hübinette (Hubbe)  push_multiset(l);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_ARRAY: { struct array *a;
7b1a741999-08-14Fredrik Hübinette (Hubbe)  a=merge_array_with_order(sp[-2].u.array, sp[-1].u.array, PIKE_ARRAY_OP_XOR);
c1d3f21999-08-16Fredrik Hübinette (Hubbe)  pop_n_elems(2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  push_array(a); return; }
fc0bb51997-02-13Niels Möller 
dc7d491999-12-15Henrik Grubbström (Grubba)  case T_FUNCTION: case T_PROGRAM: { struct program *p; p = program_from_svalue(sp - 1); if (!p) { int args = 2;
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(); p = program_from_svalue(sp - 1); 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)  } /* FALL_THROUGH */
3db0d21999-12-13Henrik Grubbström (Grubba)  case T_TYPE: {
0e801c1999-12-13Henrik Grubbström (Grubba)  /* a ^ b == (a&~b)|(~a&b) */
07f5432001-02-21Henrik Grubbström (Grubba)  struct pike_type *a; struct pike_type *b;
be6fec2001-04-01Henrik Grubbström (Grubba)  copy_pike_type(a, sp[-2].u.type); copy_pike_type(b, sp[-1].u.type);
0e801c1999-12-13Henrik Grubbström (Grubba)  o_compl(); /* ~b */ o_and(); /* a&~b */
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(a);
0e801c1999-12-13Henrik Grubbström (Grubba)  o_compl(); /* ~a */
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(b);
0e801c1999-12-13Henrik Grubbström (Grubba)  o_and(); /* ~a&b */ o_or(); /* (a&~b)|(~a&b) */
3db0d21999-12-13Henrik Grubbström (Grubba)  return; }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  STRING_BITOP(^,"XOR")
fc0bb51997-02-13Niels Möller 
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`^", "Bitwise XOR on illegal type.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
b90e552001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `^(mixed arg1)
dfceb02003-11-10Martin Stjernholm  *! @decl mixed `^(mixed arg1, mixed arg2, mixed ... extras)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mixed `^(object arg1, mixed arg2) *! @decl mixed `^(mixed arg1, object arg2) *! @decl int `^(int arg1, int arg2)
dfceb02003-11-10Martin Stjernholm  *! @decl string `^(string arg1, string arg2) *! @decl array `^(array arg1, array arg2)
b90e552001-02-08Henrik Grubbström (Grubba)  *! @decl mapping `^(mapping arg1, mapping arg2) *! @decl multiset `^(multiset arg1, multiset arg2) *! @decl type `^(program|type arg1, program|type arg2) *!
dfceb02003-11-10Martin Stjernholm  *! Exclusive or. *! *! Every expression with the @expr{^@} operator becomes a call to *! this function, i.e. @expr{a^b@} is the same as *! @expr{predef::`^(a,b)@}.
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns
dfceb02003-11-10Martin Stjernholm  *! If there's a single argument, that argument is returned.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! If there are more than two arguments, the result is:
f79bd82003-04-01Martin Nilsson  *! @expr{`^(`^(@[arg1], @[arg2]), @@@[extras])@}.
b90e552001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg1] is an object with an @[lfun::`^()], that *! function is called with @[arg2] as argument, and its result is *! returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Otherwise, if @[arg2] is an object with an @[lfun::``^()], that *! function is called with @[arg1] as argument, and its result is *! returned. *! *! Otherwise the result depends on the argument types:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
dfceb02003-11-10Martin Stjernholm  *! @type int *! Bitwise exclusive or of @[arg1] and @[arg2]. *! @type string *! The result is a string where each character is the bitwise *! exclusive or of the characters in the same position in *! @[arg1] and @[arg2]. The arguments must be strings of the *! same length. *! @type array *! The result is an array with the elements in @[arg1] that *! doesn't occur in @[arg2] concatenated with those in @[arg2] *! that doesn't occur in @[arg1] (according to @[`==]). The *! order between the elements that come from the same argument *! is kept. *! *! Every element is only matched once against an element in the *! other array, so if one contains several elements that are *! equal to each other and are more than their counterparts in *! the other array, the rightmost remaining elements are kept. *! @type mapping *! The result is like @[arg1] but with the entries from @[arg1] *! and @[arg2] whose indices are different between them *! (according to @[hash_value] and @[`==]). *! @type multiset *! The result is like @[arg1] but with the entries from @[arg1] *! and @[arg2] that are different between them (according to *! @[hash_value] and @[`==]). Subsequences with orderwise equal *! entries (i.e. where @[`<] returns false) are handled just *! like the array case above. *! @type type|program *! The result is a type computed like this:
9fcd242002-05-31Martin Nilsson  *! @expr{(@[arg1]&~@[arg2])|(~@[arg1]&@[arg2])@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
dfceb02003-11-10Martin Stjernholm  *! The function is not destructive on the arguments - the result is *! always a new instance.
b90e552001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[`&()], @[`|()], @[lfun::`^()], @[lfun::``^()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_xor(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) { switch(args) {
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; if ((TYPEOF(sp[-2]) == T_OBJECT) || (TYPEOF(sp[-1]) == T_OBJECT)) goto call_lfun; if ((TYPEOF(sp[-1]) != T_INT) || (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)  switch(TYPEOF(sp[-2])) { case T_INT: if (!INT_TYPE_LSH_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer)) break;
ff0d461999-10-15Fredrik Noring  convert_stack_top_to_bignum();
0311712013-06-17Martin Nilsson 
a320e52015-09-16Henrik Grubbström (Grubba)  /* FALL_THROUGH */ 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;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(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: sp--; sp[-1].u.float_number = ldexp(sp[-1].u.float_number, sp->u.integer); 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 
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer << sp->u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
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; if ((TYPEOF(sp[-2]) == T_OBJECT) || (TYPEOF(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;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(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 
a320e52015-09-16Henrik Grubbström (Grubba)  if ((TYPEOF(sp[-1]) != T_INT) || (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) 
a320e52015-09-16Henrik Grubbström (Grubba)  sp--; switch(TYPEOF(sp[-1])) { case T_INT: if( INT_TYPE_RSH_OVERFLOW(sp[-1].u.integer, sp->u.integer) ) { if (sp[-1].u.integer < 0) { SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, -1); } else { SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, 0); } return;
ba18302002-04-20Johan Sundström  }
a320e52015-09-16Henrik Grubbström (Grubba)  break; case T_FLOAT: sp[-1].u.float_number = ldexp(sp[-1].u.float_number, -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 
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, sp[-1].u.integer >> sp->u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
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;
017b572011-10-28Henrik Grubbström (Grubba)  switch(TWO_TYPES(TYPEOF(sp[-2]), TYPEOF(sp[-1])))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
1b61661998-02-19Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_ARRAY, T_INT): { struct array *ret; struct svalue *pos; INT32 e; if(sp[-1].u.integer < 0)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`*", 2, "int(0..)");
1b61661998-02-19Fredrik Hübinette (Hubbe)  ret=allocate_array(sp[-2].u.array->size * sp[-1].u.integer); pos=ret->item; for(e=0;e<sp[-1].u.integer;e++,pos+=sp[-2].u.array->size) assign_svalues_no_free(pos, sp[-2].u.array->item, sp[-2].u.array->size, sp[-2].u.array->type_field); ret->type_field=sp[-2].u.array->type_field; pop_n_elems(2); push_array(ret); return; }
3a3bc32000-09-26Henrik Wallin  case TWO_TYPES(T_ARRAY, T_FLOAT): {
7c46f22000-10-15Henrik Grubbström (Grubba)  struct array *src;
3a3bc32000-09-26Henrik Wallin  struct array *ret; struct svalue *pos;
7c46f22000-10-15Henrik Grubbström (Grubba)  ptrdiff_t asize, delta;
3a3bc32000-09-26Henrik Wallin  if(sp[-1].u.float_number < 0)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`*", 2, "float(0..)");
7c46f22000-10-15Henrik Grubbström (Grubba)  src = sp[-2].u.array; delta = src->size; asize = (ptrdiff_t)floor(delta * sp[-1].u.float_number + 0.5); ret = allocate_array(asize); pos = ret->item;
fa95e62000-10-15Henrik Grubbström (Grubba)  if (asize > delta) {
3ee2ea2000-10-15Henrik Grubbström (Grubba)  ret->type_field = src->type_field;
3a3bc32000-09-26Henrik Wallin  assign_svalues_no_free(pos,
7c46f22000-10-15Henrik Grubbström (Grubba)  src->item, delta, src->type_field); pos += delta; asize -= delta;
fa95e62000-10-15Henrik Grubbström (Grubba)  while (asize > delta) {
7c46f22000-10-15Henrik Grubbström (Grubba)  assign_svalues_no_free(pos, ret->item, delta, ret->type_field); pos += delta; asize -= delta; delta <<= 1; } if (asize) { assign_svalues_no_free(pos, ret->item, asize, ret->type_field); } } else if (asize) {
2523ce2003-04-28Martin Stjernholm  ret->type_field = assign_svalues_no_free(pos, src->item, asize, src->type_field);
7c46f22000-10-15Henrik Grubbström (Grubba)  }
3a3bc32000-09-26Henrik Wallin  pop_n_elems(2); push_array(ret); return; } case TWO_TYPES(T_STRING, T_FLOAT): {
7c46f22000-10-15Henrik Grubbström (Grubba)  struct pike_string *src;
3a3bc32000-09-26Henrik Wallin  struct pike_string *ret; char *pos;
7c46f22000-10-15Henrik Grubbström (Grubba)  ptrdiff_t len, delta;
3a3bc32000-09-26Henrik Wallin  if(sp[-1].u.float_number < 0)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`*", 2, "float(0..)");
7c46f22000-10-15Henrik Grubbström (Grubba)  src = sp[-2].u.string; len = (ptrdiff_t)floor(src->len * sp[-1].u.float_number + 0.5); ret = begin_wide_shared_string(len, src->size_shift); len <<= src->size_shift; delta = src->len << src->size_shift; pos = ret->str;
fa95e62000-10-15Henrik Grubbström (Grubba)  if (len > delta) {
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;
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(sp[-1].u.integer < 0)
f982742016-01-26Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("`*", 2, "int(0..)");
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  ret=begin_wide_shared_string(sp[-2].u.string->len * sp[-1].u.integer, sp[-2].u.string->size_shift);
1b61661998-02-19Fredrik Hübinette (Hubbe)  pos=ret->str;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  len=sp[-2].u.string->len << sp[-2].u.string->size_shift; for(e=0;e<sp[-1].u.integer;e++,pos+=len)
59fc9e2014-09-03Martin Nilsson  memcpy(pos,sp[-2].u.string->str,len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  pop_n_elems(2);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  push_string(low_end_shared_string(ret));
1b61661998-02-19Fredrik Hübinette (Hubbe)  return; }
bce86c1996-02-25Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_ARRAY,T_STRING):
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *ret;
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  ret=implode(sp[-2].u.array,sp[-1].u.string); free_string(sp[-1].u.string); free_array(sp[-2].u.array);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_STRING, 0, string, ret);
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--; return; }
f5466b1997-02-18Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_ARRAY,T_ARRAY): { struct array *ret; ret=implode_array(sp[-2].u.array, sp[-1].u.array); pop_n_elems(2); push_array(ret);
1b61661998-02-19Fredrik Hübinette (Hubbe)  return;
f5466b1997-02-18Fredrik Hübinette (Hubbe)  }
bce86c1996-02-25Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_FLOAT,T_FLOAT):
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--; sp[-1].u.float_number *= sp[0].u.float_number; return;
bce86c1996-02-25Fredrik Hübinette (Hubbe)  case TWO_TYPES(T_FLOAT,T_INT): sp--; sp[-1].u.float_number *= (FLOAT_TYPE)sp[0].u.integer; return; case TWO_TYPES(T_INT,T_FLOAT): sp--;
13670c2015-05-25Martin Nilsson  sp[-1].u.float_number=
6e34c62003-11-13Martin Stjernholm  (FLOAT_TYPE) sp[-1].u.integer * sp[0].u.float_number;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL_TYPE(sp[-1], T_FLOAT);
bce86c1996-02-25Fredrik Hübinette (Hubbe)  return; case TWO_TYPES(T_INT,T_INT):
f306632012-12-31Arne Goedeke  { INT_TYPE res;
fe62692014-01-11Arne Goedeke  if (DO_INT_TYPE_MUL_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer, &res))
fda0de1999-10-08Fredrik Noring  {
e37a3e1999-10-09Fredrik Hübinette (Hubbe)  convert_stack_top_to_bignum(); goto do_lfun_multiply;
fda0de1999-10-08Fredrik Noring  }
0311712013-06-17Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--;
f306632012-12-31Arne Goedeke  SET_SVAL(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:
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(call_lfun(LFUN_MULTIPLY, LFUN_RMULTIPLY))
07c0731996-06-21Fredrik Hübinette (Hubbe)  return;
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`*", "Bad arguments.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
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) {
7ed4c82016-05-17Per Hedbor  double a, b;
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  if(args != 2 ) SIMPLE_WRONG_NUM_ARGS_ERROR("`**",2);
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  switch( TWO_TYPES(TYPEOF(sp[-2]), TYPEOF(sp[-1])) ) { case TWO_TYPES(T_FLOAT,T_FLOAT): a = sp[-2].u.float_number; b = sp[-1].u.float_number; goto res_is_powf;
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  case TWO_TYPES(T_FLOAT,T_INT): a = sp[-2].u.float_number; b = (double)sp[-1].u.integer; goto res_is_powf;
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  case TWO_TYPES(T_INT,T_FLOAT): a = (double)sp[-2].u.integer; b = (double)sp[-1].u.float_number;
fbff332016-05-17Per Hedbor 
7ed4c82016-05-17Per Hedbor  res_is_powf: {
7259032016-05-17Per Hedbor  sp-=2; push_float( pow( a, b ) ); return;
7ed4c82016-05-17Per Hedbor  } default: stack_swap(); convert_stack_top_to_bignum(); stack_swap(); /* fallthrough 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  { if( TYPEOF(sp[-2]) != PIKE_T_OBJECT ) { 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) { struct svalue tmp = sp[i]; sp[i++] = sp[j]; sp[j--] = tmp; } while(--args > 0) { /* Restore the order, and multiply */ stack_swap(); o_multiply(); }
07c0731996-06-21Fredrik Hübinette (Hubbe)  }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  } } static int generate_multiply(node *n) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  switch(count_args(CDR(n))) { case 1: do_docode(CDR(n),0); return 1; case 2: do_docode(CDR(n),0);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_MULTIPLY);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; default: return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_divide(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) != TYPEOF(sp[-1]) && !float_promote())
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  { if(call_lfun(LFUN_DIVIDE, LFUN_RDIVIDE)) return;
1b61661998-02-19Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TWO_TYPES(TYPEOF(sp[-2]), TYPEOF(sp[-1])))
1b61661998-02-19Fredrik Hübinette (Hubbe)  { case TWO_TYPES(T_STRING,T_INT): { struct array *a;
e4b2252000-08-09Henrik Grubbström (Grubba)  INT_TYPE len; ptrdiff_t size,e,pos=0;
1b61661998-02-19Fredrik Hübinette (Hubbe)  len=sp[-1].u.integer; if(!len)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) { len=-len;
d429a71998-02-24Fredrik Hübinette (Hubbe)  size=sp[-2].u.string->len / len; pos+=sp[-2].u.string->len % len; }else{ size=sp[-2].u.string->len / len;
1b61661998-02-19Fredrik Hübinette (Hubbe)  } a=allocate_array(size); for(e=0;e<size;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_STRING, 0, string, string_slice(sp[-2].u.string, pos,len));
1b61661998-02-19Fredrik Hübinette (Hubbe)  pos+=len; } a->type_field=BIT_STRING; pop_n_elems(2); push_array(a); return; } case TWO_TYPES(T_STRING,T_FLOAT): { struct array *a;
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t size, pos, last, e;
6e34c62003-11-13Martin Stjernholm  FLOAT_ARG_TYPE len;
1b61661998-02-19Fredrik Hübinette (Hubbe)  len=sp[-1].u.float_number; if(len==0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) { len=-len;
e4b2252000-08-09Henrik Grubbström (Grubba)  size=(ptrdiff_t)ceil( ((double)sp[-2].u.string->len) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
13670c2015-05-25Martin Nilsson 
d429a71998-02-24Fredrik Hübinette (Hubbe)  for(last=sp[-2].u.string->len,e=0;e<size-1;e++)
1b61661998-02-19Fredrik Hübinette (Hubbe)  {
61014a2000-09-26Henrik Wallin  pos=sp[-2].u.string->len - (ptrdiff_t)((e+1)*len+0.5);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[size-1-e], T_STRING, 0, string, string_slice(sp[-2].u.string, pos, last-pos));
1b61661998-02-19Fredrik Hübinette (Hubbe)  last=pos; } pos=0;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[0], T_STRING, 0, string, string_slice(sp[-2].u.string, pos, last-pos));
1b61661998-02-19Fredrik Hübinette (Hubbe)  }else{
080b1a2000-08-10Henrik Grubbström (Grubba)  size=(ptrdiff_t)ceil( ((double)sp[-2].u.string->len) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
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, string_slice(sp[-2].u.string, last, pos-last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  last=pos; }
d429a71998-02-24Fredrik Hübinette (Hubbe)  pos=sp[-2].u.string->len;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_STRING, 0, string, string_slice(sp[-2].u.string, last, pos-last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  } a->type_field=BIT_STRING; pop_n_elems(2); push_array(a);
d429a71998-02-24Fredrik Hübinette (Hubbe)  return;
1b61661998-02-19Fredrik Hübinette (Hubbe)  }
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) 
6e34c62003-11-13Martin Stjernholm  INT_TYPE len=sp[-1].u.integer;
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(!len)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
a5a6492011-03-03Martin Stjernholm  if (!Pike_sp[-2].u.array->size) { pop_n_elems (2); ref_push_array (&empty_array); return; }
13670c2015-05-25Martin Nilsson 
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) {
6f49401998-07-31Henrik Grubbström (Grubba)  len = -len; pos = sp[-2].u.array->size % len;
d429a71998-02-24Fredrik Hübinette (Hubbe)  }else{
6f49401998-07-31Henrik Grubbström (Grubba)  pos = 0;
1b61661998-02-19Fredrik Hübinette (Hubbe)  }
6f49401998-07-31Henrik Grubbström (Grubba)  size = sp[-2].u.array->size / len;
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size); for(e=0;e<size;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_ARRAY, 0, array, friendly_slice_array(sp[-2].u.array, pos, pos+len));
1b61661998-02-19Fredrik Hübinette (Hubbe)  pos+=len; } a->type_field=BIT_ARRAY; pop_n_elems(2); push_array(a); return; } case TWO_TYPES(T_ARRAY,T_FLOAT): { struct array *a;
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t last,pos,e,size;
6e34c62003-11-13Martin Stjernholm  FLOAT_ARG_TYPE len;
1b61661998-02-19Fredrik Hübinette (Hubbe)  len=sp[-1].u.float_number; if(len==0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
1b61661998-02-19Fredrik Hübinette (Hubbe) 
a5a6492011-03-03Martin Stjernholm  if (!Pike_sp[-2].u.array->size) { pop_n_elems (2); ref_push_array (&empty_array); return; }
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(len<0) { len=-len;
e4b2252000-08-09Henrik Grubbström (Grubba)  size = (ptrdiff_t)ceil( ((double)sp[-2].u.array->size) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
13670c2015-05-25Martin Nilsson 
d429a71998-02-24Fredrik Hübinette (Hubbe)  for(last=sp[-2].u.array->size,e=0;e<size-1;e++)
1b61661998-02-19Fredrik Hübinette (Hubbe)  {
61014a2000-09-26Henrik Wallin  pos=sp[-2].u.array->size - (ptrdiff_t)((e+1)*len+0.5);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[size-1-e], T_ARRAY, 0, array, friendly_slice_array(sp[-2].u.array, pos, last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  last=pos; }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[0], T_ARRAY, 0, array, slice_array(sp[-2].u.array, 0, last));
1b61661998-02-19Fredrik Hübinette (Hubbe)  }else{
080b1a2000-08-10Henrik Grubbström (Grubba)  size = (ptrdiff_t)ceil( ((double)sp[-2].u.array->size) / len);
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=allocate_array(size);
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, friendly_slice_array(sp[-2].u.array, last, pos));
1b61661998-02-19Fredrik Hübinette (Hubbe)  last=pos; }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(a->item[e], T_ARRAY, 0, array, slice_array(sp[-2].u.array, last, sp[-2].u.array->size));
1b61661998-02-19Fredrik Hübinette (Hubbe)  } a->type_field=BIT_ARRAY; pop_n_elems(2); push_array(a);
d429a71998-02-24Fredrik Hübinette (Hubbe)  return;
1b61661998-02-19Fredrik Hübinette (Hubbe)  } }
13670c2015-05-25Martin Nilsson 
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`/", "Division on different types.\n", sp, 2);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
08b9801999-10-30Fredrik Noring  do_lfun_division:
07c0731996-06-21Fredrik Hübinette (Hubbe)  CALL_OPERATOR(LFUN_DIVIDE,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_STRING: { struct array *ret;
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  ret=explode(sp[-2].u.string,sp[-1].u.string); free_string(sp[-2].u.string);
5267b71995-08-09Fredrik Hübinette (Hubbe)  free_string(sp[-1].u.string);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-2], T_ARRAY, 0, array, ret);
fb5c4f1996-03-24Fredrik Hübinette (Hubbe)  sp--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; }
f5466b1997-02-18Fredrik Hübinette (Hubbe)  case T_ARRAY: { struct array *ret=explode_array(sp[-2].u.array, sp[-1].u.array); pop_n_elems(2); push_array(ret); return; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT: if(sp[-1].u.float_number == 0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--; sp[-1].u.float_number /= sp[0].u.float_number; return; case T_INT:
806a2c1997-04-28Fredrik Hübinette (Hubbe)  {
e4b2252000-08-09Henrik Grubbström (Grubba)  INT_TYPE tmp;
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if (sp[-1].u.integer == 0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_DIVISION_BY_ZERO_ERROR("`/");
806a2c1997-04-28Fredrik Hübinette (Hubbe) 
08b9801999-10-30Fredrik Noring  if(INT_TYPE_DIV_OVERFLOW(sp[-2].u.integer, sp[-1].u.integer)) { stack_swap(); convert_stack_top_to_bignum(); stack_swap(); goto do_lfun_division; } else tmp = sp[-2].u.integer/sp[-1].u.integer; sp--;
c93f0e1997-12-03Fredrik Hübinette (Hubbe) 
08b9801999-10-30Fredrik Noring  /* What is this trying to solve? /Noring */
6e34c62003-11-13Martin Stjernholm  /* It fixes rounding towards negative infinity. /mast */
c93f0e1997-12-03Fredrik Hübinette (Hubbe)  if((sp[-1].u.integer<0) != (sp[0].u.integer<0)) if(tmp*sp[0].u.integer!=sp[-1].u.integer)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  tmp--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, tmp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
806a2c1997-04-28Fredrik Hübinette (Hubbe)  }
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`/", "Bad argument 1.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `/(object arg1, mixed arg2) *! @decl mixed `/(mixed arg1, object arg2) *! @decl array(string) `/(string arg1, int arg2) *! @decl array(string) `/(string arg1, float arg2) *! @decl array(array) `/(array arg1, int arg2) *! @decl array(array) `/(array arg1, float arg2)
441e212002-12-30Henrik Grubbström (Grubba)  *! @decl array(string) `/(string arg1, string arg2)
8d1b862001-02-08Henrik Grubbström (Grubba)  *! @decl array(array) `/(array arg1, array arg2) *! @decl float `/(float arg1, int|float arg2) *! @decl float `/(int arg1, float arg2) *! @decl int `/(int arg1, int arg2) *! @decl mixed `/(mixed arg1, mixed arg2, mixed ... extras)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Division/split. *! *! Every expression with the @expr{/@} operator becomes a call to *! this function, i.e. @expr{a/b@} is the same as *! @expr{predef::`/(a,b)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns *! If there are more than two arguments, the result will be
9fcd242002-05-31Martin Nilsson  *! @expr{`/(`/(@[arg1], @[arg2]), @@@[extras])@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! If @[arg1] is an object that implements @[lfun::`/()], that *! function will be called with @[arg2] as the single argument. *! *! If @[arg2] is an object that implements @[lfun::``/()], that *! function will be called with @[arg1] as the single argument. *! *! Otherwise the result will be as follows:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type string
b00d6d2001-07-27Martin Nilsson  *! @mixed arg2
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type int|float
28984e2001-05-09Henrik Grubbström (Grubba)  *! The result will be and array of @[arg1] split in segments *! of length @[arg2]. If @[arg2] is negative the splitting *! will start from the end of @[arg1]. *! @type string *! The result will be an array of @[arg1] split at each *! occurrence of @[arg2]. Note that the segments that *! matched against @[arg2] will not be in the result. *! @endmixed *! @type array
b00d6d2001-07-27Martin Nilsson  *! @mixed arg2
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type int|float
28984e2001-05-09Henrik Grubbström (Grubba)  *! The result will be and array of @[arg1] split in segments *! of length @[arg2]. If @[arg2] is negative the splitting *! will start from the end of @[arg1]. *! @type array *! The result will be an array of @[arg1] split at each *! occurrence of @[arg2]. Note that the elements that *! matched against @[arg2] will not be in the result. *! @endmixed
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type float|int
9fcd242002-05-31Martin Nilsson  *! The result will be @expr{@[arg1] / @[arg2]@}. If both arguments
28984e2001-05-09Henrik Grubbström (Grubba)  *! are int, the result will be truncated to an int. Otherwise the *! result will be a float. *! @endmixed
b8d9a02003-01-15Johan Sundström  *! @note
7f95db2003-01-15Martin Nilsson  *! Unlike in some languages, the function f(x) = x/n (x and n integers) *! behaves in a well-defined way and is always rounded down. When you *! increase x, f(x) will increase with one for each n:th increment. For *! all x, (x + n) / n = x/n + 1; crossing
b8d9a02003-01-15Johan Sundström  *! zero is not special. This also means that / and % are compatible, so *! that a = b*(a/b) + a%b for all a and b. *! @seealso *! @[`%]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_divide(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) {
5b4dd31998-02-23Fredrik Hübinette (Hubbe)  switch(args) {
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; struct svalue *s=sp-args; push_svalue(s); for(e=1;e<args;e++) { push_svalue(s+e); o_divide(); } assign_svalue(s,sp-1); pop_n_elems(sp-s-1); } }
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) } static int generate_divide(node *n) { if(count_args(CDR(n))==2) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
5e44422001-02-25Fredrik Hübinette (Hubbe)  do_docode(CDR(n),DO_NOT_COPY_TOPLEVEL);
a96ce92000-04-19Fredrik Hübinette (Hubbe)  emit0(F_DIVIDE);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(-1);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void o_mod(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) != TYPEOF(sp[-1]) && !float_promote())
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  {
34e2782013-01-11Arne Goedeke do_lfun_modulo:
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(call_lfun(LFUN_MOD, LFUN_RMOD)) return;
017b572011-10-28Henrik Grubbström (Grubba)  switch(TWO_TYPES(TYPEOF(sp[-2]), TYPEOF(sp[-1])))
1b61661998-02-19Fredrik Hübinette (Hubbe)  { case TWO_TYPES(T_STRING,T_INT): { struct pike_string *s=sp[-2].u.string;
e4b2252000-08-09Henrik Grubbström (Grubba)  ptrdiff_t tmp,base;
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(!sp[-1].u.integer)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
1b61661998-02-19Fredrik Hübinette (Hubbe) 
6e34c62003-11-13Martin Stjernholm  if(sp[-1].u.integer<0)
d429a71998-02-24Fredrik Hübinette (Hubbe)  {
6e34c62003-11-13Martin Stjernholm  tmp=s->len % -sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=0; }else{
6e34c62003-11-13Martin Stjernholm  tmp=s->len % sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=s->len - tmp; }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  s=string_slice(s, base, tmp);
1b61661998-02-19Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_string(s); return; } case TWO_TYPES(T_ARRAY,T_INT): { struct array *a=sp[-2].u.array;
6e34c62003-11-13Martin Stjernholm  ptrdiff_t tmp,base;
1b61661998-02-19Fredrik Hübinette (Hubbe)  if(!sp[-1].u.integer)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
1b61661998-02-19Fredrik Hübinette (Hubbe) 
6e34c62003-11-13Martin Stjernholm  if(sp[-1].u.integer<0)
d429a71998-02-24Fredrik Hübinette (Hubbe)  {
6e34c62003-11-13Martin Stjernholm  tmp=a->size % -sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=0; }else{
6e34c62003-11-13Martin Stjernholm  tmp=a->size % sp[-1].u.integer;
d429a71998-02-24Fredrik Hübinette (Hubbe)  base=a->size - tmp; }
1b61661998-02-19Fredrik Hübinette (Hubbe)  a=slice_array(a,base,base+tmp); pop_n_elems(2); push_array(a); return; } }
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`%", "Modulo on different types.\n", sp, 2);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-2]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_MOD,2); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT: { FLOAT_TYPE foo; if(sp[-1].u.float_number == 0.0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp--;
bd67392015-10-14Martin Nilsson  foo = (FLOAT_TYPE)(sp[-1].u.float_number / sp[0].u.float_number); foo = (FLOAT_TYPE)(sp[-1].u.float_number - sp[0].u.float_number * floor(foo));
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp[-1].u.float_number=foo; return; } case T_INT:
34e2782013-01-11Arne Goedeke  { int of = 0; INT_TYPE a = sp[-2].u.integer, b = sp[-1].u.integer; INT_TYPE res; if (b == 0)
54db6c1999-03-27Henrik Grubbström (Grubba)  OP_MODULO_BY_ZERO_ERROR("`%");
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; } sp--; SET_SVAL(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:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`%", "Bad argument 1.\n", sp, 2);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `%(object arg1, mixed arg2) *! @decl mixed `%(mixed arg1, object arg2) *! @decl string `%(string arg1, int arg2) *! @decl array `%(array arg1, int arg2) *! @decl float `%(float arg1, float|int arg2) *! @decl float `%(int arg1, float arg2) *! @decl int `%(int arg1, int arg2)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Modulo. *! *! Every expression with the @expr{%@} operator becomes a call to *! this function, i.e. @expr{a%b@} is the same as *! @expr{predef::`%(a,b)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns *! If @[arg1] is an object that implements @[lfun::`%()] then *! that function will be called with @[arg2] as the single argument. *! *! If @[arg2] is an object that implements @[lfun::``%()] then *! that function will be called with @[arg2] as the single argument. *! *! Otherwise the result will be as follows:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg1
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type string|array
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg2] is positive, the result will be the last
9fcd242002-05-31Martin Nilsson  *! @expr{`%(@[sizeof](@[arg1]), @[arg2])@} elements of @[arg1].
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg2] is negative, the result will be the first
9fcd242002-05-31Martin Nilsson  *! @expr{`%(@[sizeof](@[arg1]), -@[arg2])@} elements of @[arg1].
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type int|float
28984e2001-05-09Henrik Grubbström (Grubba)  *! The result will be
9fcd242002-05-31Martin Nilsson  *! @expr{@[arg1] - @[arg2]*@[floor](@[arg1]/@[arg2])@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! The result will be a float if either @[arg1] or @[arg2] is *! a float, and an int otherwise. *! @endmixed
b8d9a02003-01-15Johan Sundström  *! *! For numbers, this means that *! @ol *! @item
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) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_INT:
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, !sp[-1].u.integer);
07c0731996-06-21Fredrik Hübinette (Hubbe)  break; case T_FUNCTION: case T_OBJECT:
9f516a2001-12-16Martin Stjernholm  if(UNSAFE_IS_ZERO(sp-1))
07c0731996-06-21Fredrik Hübinette (Hubbe)  { pop_stack(); push_int(1); }else{ pop_stack(); push_int(0); } break; default: free_svalue(sp-1);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @decl int(0..1) `!(object|function arg) *! @decl int(1..1) `!(int(0..0) arg) *! @decl int(0..0) `!(mixed arg)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Logical not. *! *! Every expression with the @expr{!@} operator becomes a call to *! this function, i.e. @expr{!a@} is the same as *! @expr{predef::`!(a)@}. *! *! It's also used when necessary to test truth on objects, i.e. in *! a statement @expr{if (o) ...@} where @expr{o@} is an object, the *! test becomes the equivalent of @expr{!!o@} so that any *! @[lfun::`!()] the object might have gets called.
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @returns *! If @[arg] is an object that implements @[lfun::`!()], that function *! will be called.
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! If @[arg] is @expr{0@} (zero), a destructed object, or a function in a *! destructed object, @expr{1@} will be returned.
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! Otherwise @expr{0@} (zero) will be returned.
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! @note *! No float is considered false, not even @expr{0.0@}. *!
8d1b862001-02-08Henrik Grubbström (Grubba)  *! @seealso *! @[`==()], @[`!=()], @[lfun::`!()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_not(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) {
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) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT: CALL_OPERATOR(LFUN_COMPL,1); break;
13670c2015-05-25Martin Nilsson 
8a630c1996-04-13Fredrik Hübinette (Hubbe)  case T_INT:
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, ~sp[-1].u.integer);
8a630c1996-04-13Fredrik Hübinette (Hubbe)  break; case T_FLOAT:
e956bb2008-07-11Martin Stjernholm  sp[-1].u.float_number = (FLOAT_TYPE) -1.0 - sp[-1].u.float_number;
8a630c1996-04-13Fredrik Hübinette (Hubbe)  break;
0e801c1999-12-13Henrik Grubbström (Grubba)  case T_TYPE: type_stack_mark();
1a94cc2001-02-26Henrik Grubbström (Grubba)  if (sp[-1].u.type->type == T_NOT) { push_finished_type(sp[-1].u.type->car);
dc7d491999-12-15Henrik Grubbström (Grubba)  } else {
1a94cc2001-02-26Henrik Grubbström (Grubba)  push_finished_type(sp[-1].u.type);
dc7d491999-12-15Henrik Grubbström (Grubba)  push_type(T_NOT); }
0e801c1999-12-13Henrik Grubbström (Grubba)  pop_stack();
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(pop_unfinished_type());
0e801c1999-12-13Henrik Grubbström (Grubba)  break;
dc7d491999-12-15Henrik Grubbström (Grubba)  case T_FUNCTION: case T_PROGRAM: { /* !object(p) */ struct program *p = program_from_svalue(sp - 1); if (!p) { PIKE_ERROR("`~", "Bad argument.\n", sp, 1); } type_stack_mark();
3611422001-02-20Henrik Grubbström (Grubba)  push_object_type(0, p->id);
dc7d491999-12-15Henrik Grubbström (Grubba)  push_type(T_NOT); pop_stack();
07f5432001-02-21Henrik Grubbström (Grubba)  push_type_value(pop_unfinished_type());
dc7d491999-12-15Henrik Grubbström (Grubba)  } break;
fc0bb51997-02-13Niels Möller  case T_STRING: { struct pike_string *s;
080b1a2000-08-10Henrik Grubbström (Grubba)  ptrdiff_t len, i;
fc0bb51997-02-13Niels Möller 
54db6c1999-03-27Henrik Grubbström (Grubba)  if(sp[-1].u.string->size_shift) { bad_arg_error("`~", sp-1, 1, 1, "string(0)", sp-1, "Expected 8-bit string.\n"); }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) 
fc0bb51997-02-13Niels Möller  len = sp[-1].u.string->len; s = begin_shared_string(len); for (i=0; i<len; i++) s->str[i] = ~ sp[-1].u.string->str[i]; pop_n_elems(1); push_string(end_shared_string(s)); break; }
8a630c1996-04-13Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`~", "Bad argument.\n", sp, 1);
8a630c1996-04-13Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `~(object arg) *! @decl int `~(int arg) *! @decl float `~(float arg) *! @decl type `~(type|program arg) *! @decl string `~(string arg)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Complement/inversion. *! *! Every expression with the @expr{~@} operator becomes a call to *! this function, i.e. @expr{~a@} is the same as *! @expr{predef::`~(a)@}.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns *! The result will be as follows:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type object *! If @[arg] implements @[lfun::`~()], that function will be called. *! @type int *! The bitwise inverse of @[arg] will be returned. *! @type float
9fcd242002-05-31Martin Nilsson  *! The result will be @expr{-1.0 - @[arg]@}.
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type type|program
28984e2001-05-09Henrik Grubbström (Grubba)  *! The type inverse of @[arg] will be returned. *! @type string
c7b7dd2001-10-28Martin Nilsson  *! If @[arg] only contains characters in the range 0 - 255 (8-bit),
28984e2001-05-09Henrik Grubbström (Grubba)  *! a string containing the corresponding 8-bit inverses will be *! returned. *! @endmixed
8d1b862001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[`!()], @[lfun::`~()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_compl(INT32 args)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) {
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) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
07c0731996-06-21Fredrik Hübinette (Hubbe)  case T_OBJECT:
ff0d461999-10-15Fredrik Noring  do_lfun_negate:
07c0731996-06-21Fredrik Hübinette (Hubbe)  CALL_OPERATOR(LFUN_SUBTRACT,1); break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_FLOAT: sp[-1].u.float_number=-sp[-1].u.float_number; return;
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT:
ff0d461999-10-15Fredrik Noring  if(INT_TYPE_NEG_OVERFLOW(sp[-1].u.integer)) { convert_stack_top_to_bignum(); goto do_lfun_negate; }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, -sp[-1].u.integer);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return;
13670c2015-05-25Martin Nilsson  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`-", "Bad argument to unary minus.\n", sp, 1);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
408a1e2004-10-30Martin Stjernholm static void string_or_array_range (int bound_types, struct svalue *ind, INT_TYPE low, INT_TYPE high) /* ind is modified to point to the range. low and high are INT_TYPE to * avoid truncation problems when they come from int svalues. */
5267b71995-08-09Fredrik Hübinette (Hubbe) {
408a1e2004-10-30Martin Stjernholm  INT32 from, to, len; /* to and len are not inclusive. */
8a586b1997-01-27Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_STRING)
408a1e2004-10-30Martin Stjernholm  len = ind->u.string->len; else { #ifdef PIKE_DEBUG
017b572011-10-28Henrik Grubbström (Grubba)  if (!ind || TYPEOF(*ind) != T_ARRAY) Pike_fatal ("Invalid ind svalue.\n");
408a1e2004-10-30Martin Stjernholm #endif len = ind->u.array->size;
8a586b1997-01-27Fredrik Hübinette (Hubbe)  }
408a1e2004-10-30Martin Stjernholm  if (bound_types & RANGE_LOW_OPEN) from = 0; else {
07cc182008-09-04Marcus Comstedt  if (bound_types & RANGE_LOW_FROM_END) { if (low >= len) from = 0; else if (low < 0) from = len; else from = len - 1 - low; } else { if (low < 0) from = 0; else if (low > len) from = len; else from = low; }
408a1e2004-10-30Martin Stjernholm  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
408a1e2004-10-30Martin Stjernholm  if (bound_types & RANGE_HIGH_OPEN) to = len; else {
07cc182008-09-04Marcus Comstedt  if (bound_types & RANGE_HIGH_FROM_END) { if (high > len - from) to = from; else if (high <= 0) to = len; else to = len - high; } else { if (high < from) to = from; else if (high >= len) to = len; else to = high + 1; }
408a1e2004-10-30Martin Stjernholm  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*ind) == T_STRING) {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s;
408a1e2004-10-30Martin Stjernholm  if (from == 0 && to == len) return;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
408a1e2004-10-30Martin Stjernholm  s=string_slice(ind->u.string, from, to-from); free_string(ind->u.string); ind->u.string=s; } else { struct array *a; a = slice_array(ind->u.array, from, to); free_array(ind->u.array); ind->u.array=a; } } static int call_old_range_lfun (int bound_types, struct object *o, struct svalue *low, struct svalue *high) /* Returns nonzero on errors to let the caller format the appropriate * messages to throw. o is assumed to be undestructed on entry. One * ref each is consumed to low and high when they're in use. */ { struct svalue end_pos; ONERROR uwp; int f; if ((f = FIND_LFUN (o->prog, LFUN_INDEX)) == -1) return 1; /* FIXME: Check if the `[] lfun accepts at least two arguments. */ /* o[a..b] => o->`[] (a, b) * o[a..<b] => o->`[] (a, o->_sizeof()-1-b) * o[a..] => o->`[] (a, Pike.NATIVE_MAX) * o[<a..b] => o->`[] (o->_sizeof()-1-a, b) * o[<a..<b] => o->`[] (o->_sizeof()-1-a, o->_sizeof()-1-b) * o[<a..] => o->`[] (o->_sizeof()-1-a, Pike.NATIVE_MAX) * o[..b] => o->`[] (0, b) * o[..<b] => o->`[] (0, o->_sizeof()-1-b) * o[..] => o->`[] (0, Pike.NATIVE_MAX) */ if (bound_types & (RANGE_LOW_FROM_END|RANGE_HIGH_FROM_END)) { int f2 = FIND_LFUN (o->prog, LFUN__SIZEOF); if (f2 == -1) return 2; apply_low (o, f2, 0); push_int (1); o_subtract(); move_svalue (&end_pos, --sp); SET_ONERROR (uwp, do_free_svalue, &end_pos); } switch (bound_types & (RANGE_LOW_FROM_BEG|RANGE_LOW_FROM_END|RANGE_LOW_OPEN)) { case RANGE_LOW_FROM_BEG: move_svalue (sp++, low);
0c21e52008-03-29Martin Stjernholm  mark_free_svalue (low);
408a1e2004-10-30Martin Stjernholm  break; case RANGE_LOW_OPEN: push_int (0); break; default: push_svalue (&end_pos); move_svalue (sp++, low);
0c21e52008-03-29Martin Stjernholm  mark_free_svalue (low);
408a1e2004-10-30Martin Stjernholm  o_subtract(); break; } switch (bound_types & (RANGE_HIGH_FROM_BEG|RANGE_HIGH_FROM_END|RANGE_HIGH_OPEN)) { case RANGE_HIGH_FROM_BEG: move_svalue (sp++, high);
0c21e52008-03-29Martin Stjernholm  mark_free_svalue (high);
408a1e2004-10-30Martin Stjernholm  break; case RANGE_HIGH_OPEN: push_int (MAX_INT_TYPE); break; default: push_svalue (&end_pos); move_svalue (sp++, high);
0c21e52008-03-29Martin Stjernholm  mark_free_svalue (high);
408a1e2004-10-30Martin Stjernholm  o_subtract(); break; } if (bound_types & (RANGE_LOW_FROM_END|RANGE_HIGH_FROM_END)) { UNSET_ONERROR (uwp); free_svalue (&end_pos); /* Anything might have happened during the calls to * LFUN__SIZEOF and o_subtract above. */ if (!o->prog) return 3; } apply_low (o, f, 2); return 0; } static const char *range_func_name (int bound_types) { /* Since the number of arguments on the stack depend on bound_types * we have to make some effort to make it show in the backtrace. */ switch (bound_types) { case RANGE_LOW_FROM_BEG|RANGE_HIGH_FROM_BEG: return "arg1[arg2..arg3]"; case RANGE_LOW_FROM_BEG|RANGE_HIGH_FROM_END: return "arg1[arg2..<arg3]"; case RANGE_LOW_FROM_BEG|RANGE_HIGH_OPEN: return "arg1[arg2..]"; case RANGE_LOW_FROM_END|RANGE_HIGH_FROM_BEG: return "arg1[<arg2..arg3]"; case RANGE_LOW_FROM_END|RANGE_HIGH_FROM_END: return "arg1[<arg2..<arg3]"; case RANGE_LOW_FROM_END|RANGE_HIGH_OPEN: return "arg1[<arg2..]"; case RANGE_LOW_OPEN|RANGE_HIGH_FROM_BEG: return "arg1[..arg2]"; case RANGE_LOW_OPEN|RANGE_HIGH_FROM_END: return "arg1[..<arg2]"; case RANGE_LOW_OPEN|RANGE_HIGH_OPEN: return "arg1[..]";
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
408a1e2004-10-30Martin Stjernholm  default: Pike_fatal ("Unexpected bound_types.\n");
62260a1996-11-26Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
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; high = bound_types & RANGE_HIGH_OPEN ? sp : sp - 1; low = bound_types & RANGE_LOW_OPEN ? high : high - 1; ind = low - 1;
017b572011-10-28Henrik Grubbström (Grubba)  switch (TYPEOF(*ind)) {
408a1e2004-10-30Martin Stjernholm  case T_OBJECT: { struct object *o = ind->u.object; int f; if (!o->prog) bad_arg_error (range_func_name (bound_types), ind, sp - ind, 1, "object", ind, "Cannot call `[..] in destructed object.\n");
017b572011-10-28Henrik Grubbström (Grubba)  if ((f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(*ind)].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN_RANGE)) != -1) {
408a1e2004-10-30Martin Stjernholm  struct svalue h; if (!(bound_types & RANGE_HIGH_OPEN)) { move_svalue (&h, high); sp = high; } if (bound_types & RANGE_LOW_FROM_BEG) push_int (INDEX_FROM_BEG); else if (bound_types & RANGE_LOW_OPEN) { push_int (0); push_int (OPEN_BOUND); } else push_int (INDEX_FROM_END); if (bound_types & RANGE_HIGH_FROM_BEG) { move_svalue (sp++, &h); push_int (INDEX_FROM_BEG); } else if (bound_types & RANGE_HIGH_OPEN) { push_int (0); push_int (OPEN_BOUND); } else { move_svalue (sp++, &h); push_int (INDEX_FROM_END); } apply_low (o, f, 4); stack_pop_keep_top(); }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
408a1e2004-10-30Martin Stjernholm  else switch (call_old_range_lfun (bound_types, o, low, high)) { case 1: bad_arg_error (range_func_name (bound_types), ind, sp - ind, 1, "object", ind, "Object got neither `[..] nor `[].\n");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  case 2: bad_arg_error (range_func_name (bound_types), ind, sp - ind, 1, "object", ind, "Object got no `[..] and there is no _sizeof to " "translate the from-the-end index to use `[].\n");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  case 3: bad_arg_error (range_func_name (bound_types), ind, 3, 1, "object", ind, "Cannot call `[..] in destructed object.\n");
fb8cc02015-05-01Henrik Grubbström (Grubba)  break;
408a1e2004-10-30Martin Stjernholm  default: free_svalue (ind); move_svalue (ind, sp - 1); /* low and high have lost their refs in call_old_range_lfun. */ 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), ind, sp - ind, 2, "int", low, "Bad lower bound. Expected int, got %s.\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type (TYPEOF(*low)));
408a1e2004-10-30Martin Stjernholm  l = low->u.integer; } if (!(bound_types & RANGE_HIGH_OPEN)) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*high) != T_INT)
408a1e2004-10-30Martin Stjernholm  bad_arg_error (range_func_name (bound_types), ind, sp - ind, high - ind + 1, "int", high, "Bad upper bound. Expected int, got %s.\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type (TYPEOF(*high)));
408a1e2004-10-30Martin Stjernholm  h = high->u.integer; } /* Can pop off the bounds without fuzz since they're simple integers. */ sp = ind + 1; string_or_array_range (bound_types, ind, l, h); break; } default: bad_arg_error (range_func_name (bound_types), ind, sp - ind, 1, "string|array|object", ind, "Cannot use [..] on a %s. Expected string, array or object.\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type (TYPEOF(*ind)));
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
408a1e2004-10-30Martin Stjernholm } /*! @decl mixed `[..](object arg, mixed start, int start_type, mixed end, int end_type) *! @decl string `[..](string arg, int start, int start_type, int end, int end_type) *! @decl array `[..](array arg, int start, int start_type, int end, int end_type) *! *! Extracts a subrange. *! *! This is the function form of expressions with the @expr{[..]@} *! operator. @[arg] is the thing from which the subrange is to be *! extracted. @[start] is the lower bound of the subrange and *! @[end] the upper bound. *! *! @[start_type] and @[end_type] specifies how the @[start] and *! @[end] indices, respectively, are to be interpreted. The types *! are either @[Pike.INDEX_FROM_BEG], @[Pike.INDEX_FROM_END] or *! @[Pike.OPEN_BOUND]. In the last case, the index value is *! insignificant. *! *! The relation between @expr{[..]@} expressions and this function *! is therefore as follows: *! *! @code *! a[i..j] <=> `[..] (a, i, Pike.INDEX_FROM_BEG, j, Pike.INDEX_FROM_BEG) *! a[i..<j] <=> `[..] (a, i, Pike.INDEX_FROM_BEG, j, Pike.INDEX_FROM_END) *! a[i..] <=> `[..] (a, i, Pike.INDEX_FROM_BEG, 0, Pike.OPEN_BOUND) *! a[<i..j] <=> `[..] (a, i, Pike.INDEX_FROM_END, j, Pike.INDEX_FROM_BEG) *! a[<i..<j] <=> `[..] (a, i, Pike.INDEX_FROM_END, j, Pike.INDEX_FROM_END) *! a[<i..] <=> `[..] (a, i, Pike.INDEX_FROM_END, 0, Pike.OPEN_BOUND) *! a[..j] <=> `[..] (a, 0, Pike.OPEN_BOUND, j, Pike.INDEX_FROM_BEG) *! a[..<j] <=> `[..] (a, 0, Pike.OPEN_BOUND, j, Pike.INDEX_FROM_END) *! a[..] <=> `[..] (a, 0, Pike.OPEN_BOUND, 0, Pike.OPEN_BOUND) *! @endcode *! *! The subrange is specified as follows by the two bounds: *! *! @ul *! @item *! If the lower bound refers to an index before the lowest *! allowable (typically zero) then it's taken as an open bound *! which starts at the first index (without any error). *! *! @item *! Correspondingly, if the upper bound refers to an index past *! the last allowable then it's taken as an open bound which *! ends at the last index (without any error). *! *! @item *! If the lower bound is less than or equal to the upper bound, *! then the subrange is the inclusive range between them, i.e. *! from and including the element at the lower bound and up to *! and including the element at the upper bound. *! *! @item *! If the lower bound is greater than the upper bound then the *! result is an empty subrange (without any error). *! @endul *! *! @returns *! The returned value depends on the type of @[arg]: *! *! @mixed arg *! @type string *! A string with the characters in the range is returned. *! *! @type array *! An array with the elements in the range is returned. *! *! @type object *! If the object implements @[lfun::`[..]], that function is *! called with the four remaining arguments. *! *! As a compatibility measure, if the object does not implement *! @[lfun::`[..]] but @[lfun::`[]] then the latter is called *! with the bounds transformed to normal from-the-beginning *! indices in array-like fashion: *! *! @dl
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_BEG, j, Pike.INDEX_FROM_BEG)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (i, j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_BEG, j, Pike.INDEX_FROM_END)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (i, a->_sizeof()-1-j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_BEG, 0, Pike.OPEN_BOUND)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (i, @[Int.NATIVE_MAX])@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_END, j, Pike.INDEX_FROM_BEG)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (a->_sizeof()-1-i, j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_END, j, Pike.INDEX_FROM_END)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (a->_sizeof()-1-i, a->_sizeof()-1-j)@}, *! except that @expr{a->_sizeof()@} is called only once.
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, i, Pike.INDEX_FROM_END, 0, Pike.OPEN_BOUND)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (a->_sizeof()-1-i, @[Int.NATIVE_MAX])@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, 0, Pike.OPEN_BOUND, j, Pike.INDEX_FROM_BEG)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (0, j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, 0, Pike.OPEN_BOUND, j, Pike.INDEX_FROM_END)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (0, a->_sizeof()-1-j)@}
dfbf4c2011-12-05Arne Goedeke  *! @item @expr{`[..] (a, 0, Pike.OPEN_BOUND, 0, Pike.OPEN_BOUND)@}
408a1e2004-10-30Martin Stjernholm  *! Calls @expr{a->`[] (0, @[Int.NATIVE_MAX])@} *! @enddl *! *! Note that @[Int.NATIVE_MAX] might be replaced with an even *! larger integer in the future. *! @endmixed *! *! @seealso *! @[lfun::`[..]], @[`[]] */ PMOD_EXPORT void f_range(INT32 args) { struct svalue *ind; if (args != 5) SIMPLE_WRONG_NUM_ARGS_ERROR ("predef::`[..]", 5); ind = sp - 5; #define CALC_BOUND_TYPES(bound_types) do { \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(ind[2]) != T_INT) \
408a1e2004-10-30Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("predef::`[..]", 3, "int"); \ switch (ind[2].u.integer) { \ case INDEX_FROM_BEG: bound_types = RANGE_LOW_FROM_BEG; break; \ case INDEX_FROM_END: bound_types = RANGE_LOW_FROM_END; break; \ case OPEN_BOUND: bound_types = RANGE_LOW_OPEN; break; \ default: \ SIMPLE_ARG_ERROR ("predef::`[..]", 3, "Unrecognized bound type."); \ } \ \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(ind[4]) != T_INT) \
408a1e2004-10-30Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("predef::`[..]", 5, "int"); \ switch (ind[4].u.integer) { \ case INDEX_FROM_BEG: bound_types |= RANGE_HIGH_FROM_BEG; break; \ case INDEX_FROM_END: bound_types |= RANGE_HIGH_FROM_END; break; \ case OPEN_BOUND: bound_types |= RANGE_HIGH_OPEN; break; \ default: \ SIMPLE_ARG_ERROR ("predef::`[..]", 5, "Unrecognized bound type."); \ } \ } while (0)
017b572011-10-28Henrik Grubbström (Grubba)  switch (TYPEOF(*ind)) {
408a1e2004-10-30Martin Stjernholm  case T_OBJECT: { struct object *o = ind->u.object; int f; if (!o->prog) SIMPLE_ARG_ERROR ("predef::`[..]", 1, "Cannot call `[..] in destructed object.\n");
017b572011-10-28Henrik Grubbström (Grubba)  if ((f = FIND_LFUN(o->prog->inherits[SUBTYPEOF(*ind)].prog,
9793b72004-12-18Henrik Grubbström (Grubba)  LFUN_RANGE)) != -1) {
408a1e2004-10-30Martin Stjernholm  apply_low (o, f, 4); stack_pop_keep_top(); } else { int bound_types; CALC_BOUND_TYPES (bound_types); switch (call_old_range_lfun (bound_types, o, ind + 1, ind + 3)) { case 1: SIMPLE_ARG_ERROR ("predef::`[..]", 1, "Object got neither `[..] nor `[].\n");
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); move_svalue (ind, sp - 1); /* The bound types are simple integers and the bounds * themselves have lost their refs in call_old_range_lfun. */ sp = ind + 1;
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-29Martin Stjernholm  *! The non-protected (i.e. public) symbol named @[index] is *! looked up in @[arg].
408a1e2004-10-30Martin Stjernholm  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type int
408a1e2004-10-30Martin Stjernholm  *! The bignum function named @[index] is looked up in @[arg]. *! The bignum functions are the same as those in the @[Gmp.mpz] *! class. *! *! @type string *! The character at index @[index] in @[arg] is returned as an *! integer. The first character in the string is at index *! @expr{0@} and the highest allowed index is therefore *! @expr{sizeof(@[arg])-1@}. A negative index number accesses *! the string from the end instead, from @expr{-1@} for the *! last char back to @expr{-sizeof(@[arg])@} for the first. *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type array
408a1e2004-10-30Martin Stjernholm  *! If @[index] is an int, index number @[index] of @[arg] is *! returned. Allowed index number are in the range *! @expr{[-sizeof(@[arg])..sizeof(@[arg])-1]@}; see the string *! case above for details. *! *! If @[index] is not an int, an array of all elements in *! @[arg] indexed with @[index] are returned. I.e. it's the *! same as doing @expr{column(@[arg], @[index])@}. *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type mapping
408a1e2004-10-30Martin Stjernholm  *! If @[index] exists in @[arg] the corresponding value is *! returned. Otherwise @expr{UNDEFINED@} is returned. *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type multiset
408a1e2004-10-30Martin Stjernholm  *! If @[index] exists in @[arg], @expr{1@} is returned. *! Otherwise @expr{UNDEFINED@} is returned. *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type program
30c0612008-06-29Martin Stjernholm  *! The non-protected (i.e. public) constant symbol @[index] is
28984e2001-05-09Henrik Grubbström (Grubba)  *! looked up in @[arg]. *! *! @endmixed
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
408a1e2004-10-30Martin Stjernholm  *! As a compatibility measure, this function also performs range *! operations if it's called with three arguments. In that case it *! becomes equivalent to: *! *! @code *! @[`[..]] (arg, start, @[Pike.INDEX_FROM_BEG], end, @[Pike.INDEX_FROM_BEG]) *! @endcode *! *! See @[`[..]] for further details. *!
dfceb02003-11-10Martin Stjernholm  *! @note *! An indexing expression in an lvalue context, i.e. where the *! index is being assigned a new value, uses @[`[]=] instead of *! this function. *!
8d1b862001-02-08Henrik Grubbström (Grubba)  *! @seealso
408a1e2004-10-30Martin Stjernholm  *! @[`->()], @[lfun::`[]()], @[`[]=], @[`[..]]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_index(INT32 args)
9f68471997-03-08Fredrik Hübinette (Hubbe) { switch(args) { case 2:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_STRING) SET_SVAL_SUBTYPE(sp[-1], 0);
9f68471997-03-08Fredrik Hübinette (Hubbe)  o_index(); break; case 3:
408a1e2004-10-30Martin Stjernholm  move_svalue (sp, sp - 1); sp += 2;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(sp[-1], T_INT, NUMBER_NUMBER, integer, INDEX_FROM_BEG); sp[-3] = sp[-1];
408a1e2004-10-30Martin Stjernholm  f_range (5);
9f68471997-03-08Fredrik Hübinette (Hubbe)  break; default:
408a1e2004-10-30Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("predef::`[]", args); break;
9f68471997-03-08Fredrik Hübinette (Hubbe)  } }
8d1b862001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `->(object arg, string index) *! @decl mixed `->(int arg, string index) *! @decl mixed `->(array arg, string index) *! @decl mixed `->(mapping arg, string index) *! @decl int(0..1) `->(multiset arg, string index) *! @decl mixed `->(program arg, string index)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
408a1e2004-10-30Martin Stjernholm  *! Arrow indexing.
28984e2001-05-09Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Every non-lvalue expression with the @expr{->@} operator becomes *! a call to this function. @expr{a->b@} is the same as *! @expr{predef::`^(a,"b")@} where @expr{"b"@} is the symbol *! @expr{b@} in string form. *! *! This function behaves like @[`[]], except that the index is *! passed literally as a string instead of being evaluated.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns *! If @[arg] is an object that implements @[lfun::`->()], that function *! will be called with @[index] as the single argument. *! *! Otherwise the result will be as follows:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type object
30c0612008-06-29Martin Stjernholm  *! The non-protected (ie public) symbol named @[index] will be *! looked up in @[arg].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type int *! The bignum function named @[index] will be looked up in @[arg]. *! @type array *! An array of all elements in @[arg] arrow indexed with @[index] *! will be returned. *! @type mapping *! If @[index] exists in @[arg] the corresponding value will be
cbe8c92003-04-07Martin Nilsson  *! returned. Otherwise @expr{UNDEFINED@} will be returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type multiset
cbe8c92003-04-07Martin Nilsson  *! If @[index] exists in @[arg], @expr{1@} will be returned. *! Otherwise @expr{UNDEFINED@} will be returned.
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type program
30c0612008-06-29Martin Stjernholm  *! The non-protected (ie public) constant symbol @[index] will *! be looked up in @[arg].
28984e2001-05-09Henrik Grubbström (Grubba)  *! @endmixed
8d1b862001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! @note *! In an expression @expr{a->b@}, the symbol @expr{b@} can be any *! token that matches the identifier syntax - keywords are *! disregarded in that context. *! *! @note *! An arrow indexing expression in an lvalue context, i.e. where *! the index is being assigned a new value, uses @[`->=] instead of *! this function. *!
8d1b862001-02-08Henrik Grubbström (Grubba)  *! @seealso
dfceb02003-11-10Martin Stjernholm  *! @[`[]()], @[lfun::`->()], @[::`->()], @[`->=]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_arrow(INT32 args)
9f68471997-03-08Fredrik Hübinette (Hubbe) { switch(args) { case 0: case 1:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`->", "Too few arguments.\n", sp, args);
9f68471997-03-08Fredrik Hübinette (Hubbe)  break; case 2:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_STRING) SET_SVAL_SUBTYPE(sp[-1], 1);
9f68471997-03-08Fredrik Hübinette (Hubbe)  o_index(); break; default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("`->", "Too many arguments.\n", sp, args);
9f68471997-03-08Fredrik Hübinette (Hubbe)  } }
d07e182001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `[]=(object arg, mixed index, mixed val) *! @decl mixed `[]=(object arg, string index, mixed val) *! @decl mixed `[]=(array arg, int index, mixed val) *! @decl mixed `[]=(mapping arg, mixed index, mixed val) *! @decl int(0..1) `[]=(multiset arg, mixed index, int(0..1) val)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Index assignment. *! *! Every lvalue expression with the @expr{[]@} operator becomes a *! call to this function, i.e. @expr{a[b]=c@} is the same as *! @expr{predef::`[]=(a,b,c)@}.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg] is an object that implements @[lfun::`[]=()], that function *! will be called with @[index] and @[val] as the arguments.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type object
30c0612008-06-29Martin Stjernholm  *! The non-protected (ie public) variable named @[index] will *! be looked up in @[arg], and assigned @[val].
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type array|mapping
28984e2001-05-09Henrik Grubbström (Grubba)  *! Index @[index] in @[arg] will be assigned @[val]. *! @type multiset
cbe8c92003-04-07Martin Nilsson  *! If @[val] is @expr{0@} (zero), one occurrance of @[index] in
28984e2001-05-09Henrik Grubbström (Grubba)  *! @[arg] will be removed. Otherwise @[index] will be added *! to @[arg] if it is not already there. *! @endmixed
d07e182001-02-08Henrik Grubbström (Grubba)  *! *! @returns *! @[val] will be returned. *!
dfceb02003-11-10Martin Stjernholm  *! @note *! An indexing expression in a non-lvalue context, i.e. where the *! index is being queried instead of assigned, uses @[`[]] instead *! of this function. *!
d07e182001-02-08Henrik Grubbström (Grubba)  *! @seealso
dfceb02003-11-10Martin Stjernholm  *! @[`->=()], @[lfun::`[]=()], @[`[]]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_index_assign(INT32 args)
912f171999-08-16Martin Stjernholm { switch (args) { case 0: case 1: case 2: PIKE_ERROR("`[]=", "Too few arguments.\n", sp, args); break; case 3:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) == T_STRING) SET_SVAL_SUBTYPE(sp[-2], 0);
4856a81999-08-17Martin Stjernholm  assign_lvalue (sp-3, sp-1);
e956bb2008-07-11Martin Stjernholm  stack_pop_n_elems_keep_top (2);
912f171999-08-16Martin Stjernholm  break; default: PIKE_ERROR("`[]=", "Too many arguments.\n", sp, args); } }
d07e182001-02-08Henrik Grubbström (Grubba) /*! @decl mixed `->=(object arg, string index, mixed val) *! @decl mixed `->=(mapping arg, string index, mixed val) *! @decl int(0..1) `->=(multiset arg, string index, int(0..1) val)
f09ec92001-02-07Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Arrow index assignment.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
dfceb02003-11-10Martin Stjernholm  *! Every lvalue expression with the @expr{->@} operator becomes a *! call to this function, i.e. @expr{a->b=c@} is the same as *! @expr{predef::`->=(a,"b",c)@} where @expr{"b"@} is the symbol *! @expr{b@} in string form. *! *! This function behaves like @[`[]=], except that the index is *! passed literally as a string instead of being evaluated.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
28984e2001-05-09Henrik Grubbström (Grubba)  *! If @[arg] is an object that implements @[lfun::`->=()], that function *! will be called with @[index] and @[val] as the arguments.
d07e182001-02-08Henrik Grubbström (Grubba)  *!
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type object
30c0612008-06-29Martin Stjernholm  *! The non-protected (ie public) variable named @[index] will *! be looked up in @[arg], and assigned @[val].
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type array|mapping
28984e2001-05-09Henrik Grubbström (Grubba)  *! Index @[index] in @[arg] will be assigned @[val]. *! @type multiset
cbe8c92003-04-07Martin Nilsson  *! If @[val] is @expr{0@} (zero), one occurrance of @[index] in
28984e2001-05-09Henrik Grubbström (Grubba)  *! @[arg] will be removed. Otherwise @[index] will be added *! to @[arg] if it is not already there. *! @endmixed
d07e182001-02-08Henrik Grubbström (Grubba)  *! *! @returns *! @[val] will be returned. *!
dfceb02003-11-10Martin Stjernholm  *! @note *! In an expression @expr{a->b=c@}, the symbol @expr{b@} can be any *! token that matches the identifier syntax - keywords are *! disregarded in that context. *! *! @note *! An arrow indexing expression in a non-lvalue context, i.e. where *! the index is being queried instead of assigned, uses @[`->] *! instead of this function. *!
d07e182001-02-08Henrik Grubbström (Grubba)  *! @seealso
dfceb02003-11-10Martin Stjernholm  *! @[`[]=()], @[lfun::`->=()], @[`->]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_arrow_assign(INT32 args)
4856a81999-08-17Martin Stjernholm { switch (args) { case 0: case 1: case 2: PIKE_ERROR("`->=", "Too few arguments.\n", sp, args); break; case 3:
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-2]) == T_STRING) SET_SVAL_SUBTYPE(sp[-2], 1);
4856a81999-08-17Martin Stjernholm  assign_lvalue (sp-3, sp-1); assign_svalue (sp-3, sp-1); pop_n_elems (args-1); break; default: PIKE_ERROR("`->=", "Too many arguments.\n", sp, args); } }
d07e182001-02-08Henrik Grubbström (Grubba) /*! @decl int sizeof(string arg) *! @decl int sizeof(array arg) *! @decl int sizeof(mapping arg) *! @decl int sizeof(multiset arg) *! @decl int sizeof(object arg)
13670c2015-05-25Martin Nilsson  *!
dfceb02003-11-10Martin Stjernholm  *! Size query.
28984e2001-05-09Henrik Grubbström (Grubba)  *! *! @returns *! The result will be as follows:
b00d6d2001-07-27Martin Nilsson  *! @mixed arg
28984e2001-05-09Henrik Grubbström (Grubba)  *! @type string *! The number of characters in @[arg] will be returned.
fefa0e2002-05-30Henrik Grubbström (Grubba)  *! @type array|multiset
28984e2001-05-09Henrik Grubbström (Grubba)  *! The number of elements in @[arg] will be returned. *! @type mapping *! The number of key-value pairs in @[arg] will be returned. *! @type object *! If @[arg] implements @[lfun::_sizeof()], that function will
30c0612008-06-29Martin Stjernholm  *! be called. Otherwise the number of non-protected (ie public)
28984e2001-05-09Henrik Grubbström (Grubba)  *! symbols in @[arg] will be returned. *! @endmixed
d07e182001-02-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[lfun::_sizeof()]
f09ec92001-02-07Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_sizeof(INT32 args)
4c573c1996-08-03Fredrik Hübinette (Hubbe) { INT32 tmp; if(args<1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("sizeof", "Too few arguments.\n", sp, args);
4c573c1996-08-03Fredrik Hübinette (Hubbe) 
06983f1996-09-22Fredrik Hübinette (Hubbe)  tmp=pike_sizeof(sp-args);
4c573c1996-08-03Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(tmp); }
79d2b42001-05-19Henrik Grubbström (Grubba) static node *optimize_sizeof(node *n) { if (CDR(n) && (CDR(n)->token == F_APPLY) && (CADR(n)) && (CADR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CADR(n)->u.sval) == T_FUNCTION) && (SUBTYPEOF(CADR(n)->u.sval) == FUNCTION_BUILTIN)) {
79d2b42001-05-19Henrik Grubbström (Grubba)  extern struct program *string_split_iterator_program; /* sizeof(efun(...)) */ if ((CADR(n)->u.sval.u.efun->function == f_divide) && CDDR(n) && (CDDR(n)->token == F_ARG_LIST) &&
a0c96c2007-03-20Henrik Grubbström (Grubba)  CADDR(n) && pike_types_le(CADDR(n)->type, string_type_string) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  CDDDR(n) && (CDDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDDR(n)->u.sval) == T_STRING) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CDDDR(n)->u.sval.u.string->len == 1)) { p_wchar2 split = index_shared_string(CDDDR(n)->u.sval.u.string, 0);
eed2da2001-06-11Henrik Grubbström (Grubba) 
79d2b42001-05-19Henrik Grubbström (Grubba)  /* sizeof(`/(str, "x")) */ ADD_NODE_REF2(CADDR(n), return mkefuncallnode("sizeof", mkapplynode(mkprgnode(string_split_iterator_program), mknode(F_ARG_LIST, CADDR(n), mkintnode(split)))); ); } if ((CADR(n)->u.sval.u.efun->function == f_minus) && CDDR(n) && (CDDR(n)->token == F_ARG_LIST) && CADDR(n) && (CADDR(n)->token == F_APPLY) && CAADDR(n) && (CAADDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CAADDR(n)->u.sval) == T_FUNCTION) && (SUBTYPEOF(CAADDR(n)->u.sval) == FUNCTION_BUILTIN) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CAADDR(n)->u.sval.u.efun->function == f_divide) && CDADDR(n) && (CDADDR(n)->token == F_ARG_LIST) &&
a0c96c2007-03-20Henrik Grubbström (Grubba)  CADADDR(n) && pike_types_le(CADADDR(n)->type, string_type_string) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  CDDADDR(n) && (CDDADDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDADDR(n)->u.sval) == T_STRING) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CDDADDR(n)->u.sval.u.string->len == 1) && CDDDR(n)) { /* sizeof(`-(`/(str, "x"), y)) */ if (((CDDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDDR(n)->u.sval) == T_ARRAY) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CDDDR(n)->u.sval.u.array->size == 1) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDDR(n)->u.sval.u.array->item[0]) == T_STRING) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CDDDR(n)->u.sval.u.array->item[0].u.string->len == 0)) || ((CDDDR(n)->token == F_APPLY) && CADDDR(n) && (CADDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CADDDR(n)->u.sval) == T_FUNCTION) && (SUBTYPEOF(CADDDR(n)->u.sval) == FUNCTION_BUILTIN) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CADDDR(n)->u.sval.u.efun->function == f_allocate) && CDDDDR(n) && (CDDDDR(n)->token == F_ARG_LIST) && CADDDDR(n) && (CADDDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CADDDDR(n)->u.sval) == T_INT) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CADDDDR(n)->u.sval.u.integer == 1) && CDDDDDR(n) && (CDDDDDR(n)->token == F_CONSTANT) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(CDDDDDR(n)->u.sval) == T_STRING) &&
79d2b42001-05-19Henrik Grubbström (Grubba)  (CDDDDDR(n)->u.sval.u.string->len == 0))) { /* sizeof(`-(`/(str, "x"), ({""}))) */ p_wchar2 split = index_shared_string(CDDADDR(n)->u.sval.u.string, 0); ADD_NODE_REF2(CADADDR(n), return mkefuncallnode("sizeof", mkapplynode(mkprgnode(string_split_iterator_program), mknode(F_ARG_LIST, CADADDR(n), mknode(F_ARG_LIST, mkintnode(split), mkintnode(1))))); ); } } } return NULL; }
4c573c1996-08-03Fredrik Hübinette (Hubbe) static int generate_sizeof(node *n) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
4c573c1996-08-03Fredrik Hübinette (Hubbe)  if(count_args(CDR(n)) != 1) return 0; if(do_docode(CDR(n),DO_NOT_COPY) != 1)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Count args was wrong in sizeof().\n");
956b122014-09-23Per Hedbor  if( pike_types_le( my_get_arg(&CDR(n), 0)[0]->type, string_type_string ) ) emit0(F_SIZEOF_STRING); /* else if( pike_types_le( my_get_arg(&CDR(n), 0)[0]->type, array_type_string ) ) */ /* emit0(F_SIZEOF_ARRAY); */ else emit0(F_SIZEOF);
4c573c1996-08-03Fredrik Hübinette (Hubbe)  return 1; }
4f20e92001-01-25Fredrik Hübinette (Hubbe) extern int generate_call_function(node *n);
f09ec92001-02-07Henrik Grubbström (Grubba) 
aba09a2011-12-28Henrik Grubbström (Grubba) /*! @decl void _Static_assert(int constant_expression, string constant_message) *! *! Perform a compile-time assertion check. *! *! If @[constant_expression] is false, a compiler error message *! containing @[constant_message] will be generated. *! *! @note *! Note that the function call compiles to the null statement, *! and thus does not affect the run-time. *! *! @seealso *! @[cpp::static_assert] */ static int generate__Static_assert(node *n) { struct compilation *c = THIS_COMPILATION; ptrdiff_t tmp; node **expr = my_get_arg(&_CDR(n), 0); node **msg = my_get_arg(&_CDR(n), 1); if(!expr || !msg || count_args(CDR(n)) != 2) { yyerror("Bad number of arguments to _Static_assert()."); return 1; } tmp = eval_low(*msg, 0); if (tmp < 1) { yyerror("Argument 2 to _Static_assert() is not constant."); return 1; } if (tmp > 1) pop_n_elems(tmp-1); if (TYPEOF(Pike_sp[-1]) != T_STRING) { yyerror("Bad argument 2 to _Static_assert(), expected string."); return 1; } tmp = eval_low(*expr, 0); if (tmp < 1) { pop_stack(); yyerror("Argument 1 to _Static_assert is not constant."); return 1; } if (tmp > 1) pop_n_elems(tmp-1); if (SAFE_IS_ZERO(Pike_sp-1)) { my_yyerror("Assertion failed: %S", Pike_sp[-2].u.string); } pop_n_elems(2); return 1; }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @class string_assignment */
19aaeb1998-05-25Fredrik Hübinette (Hubbe) struct program *string_assignment_program; #undef THIS
60d9872000-03-23Fredrik Hübinette (Hubbe) #define THIS ((struct string_assignment_storage *)(CURRENT_STORAGE))
da95392005-04-08Henrik Grubbström (Grubba) /*! @decl int `[](int i)
f09ec92001-02-07Henrik Grubbström (Grubba)  *! *! String index operator. */
19aaeb1998-05-25Fredrik Hübinette (Hubbe) static void f_string_assignment_index(INT32 args) {
da95392005-04-08Henrik Grubbström (Grubba)  ptrdiff_t len;
639cfa2003-05-15Martin Stjernholm  INT_TYPE i, p;
da95392005-04-08Henrik Grubbström (Grubba)  get_all_args("string[]", args, "%i", &p); if (!THIS->s) { Pike_error("Indexing uninitialized string_assignment.\n"); } len = THIS->s->len;
639cfa2003-05-15Martin Stjernholm  i = p < 0 ? p + len : p; if(i<0 || i>=len)
b99d882003-05-15Martin Stjernholm  Pike_error("Index %"PRINTPIKEINT"d is out of string range "
639cfa2003-05-15Martin Stjernholm  "%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n", p, -len, len - 1);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  else
b987f91998-10-12Fredrik Hübinette (Hubbe)  i=index_shared_string(THIS->s,i);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(i); }
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @decl int `[]=(int i, int j) *! *! String assign index operator. */
19aaeb1998-05-25Fredrik Hübinette (Hubbe) static void f_string_assignment_assign_index(INT32 args) {
639cfa2003-05-15Martin Stjernholm  INT_TYPE p, i, j;
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  union anything *u;
639cfa2003-05-15Martin Stjernholm  ptrdiff_t len; get_all_args("string[]=",args,"%i%i",&p,&j);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  if((u=get_pointer_if_this_type(THIS->lval, T_STRING))) {
639cfa2003-05-15Martin Stjernholm  len = u->string->len; i = p < 0 ? p + len : p; if(i<0 || i>=len)
b99d882003-05-15Martin Stjernholm  Pike_error("Index %"PRINTPIKEINT"d is out of string range "
639cfa2003-05-15Martin Stjernholm  "%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n", p, -len, len - 1);
da95392005-04-08Henrik Grubbström (Grubba)  if (THIS->s) free_string(THIS->s);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  u->string=modify_shared_string(u->string,i,j); copy_shared_string(THIS->s, u->string);
639cfa2003-05-15Martin Stjernholm  } else{
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  lvalue_to_svalue_no_free(sp,THIS->lval); sp++;
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_STRING) Pike_error("string[]= failed.\n");
639cfa2003-05-15Martin Stjernholm  len = sp[-1].u.string->len; i = p < 0 ? p + len : p; if(i<0 || i>=len)
b99d882003-05-15Martin Stjernholm  Pike_error("Index %"PRINTPIKEINT"d is out of string range "
639cfa2003-05-15Martin Stjernholm  "%"PRINTPTRDIFFT"d..%"PRINTPTRDIFFT"d.\n", p, -len, len - 1);
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  sp[-1].u.string=modify_shared_string(sp[-1].u.string,i,j); assign_lvalue(THIS->lval, sp-1); pop_stack(); }
639cfa2003-05-15Martin Stjernholm 
19aaeb1998-05-25Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(j); }
74dfe82012-12-30Jonas Walldén static void init_string_assignment_storage(struct object *UNUSED(o))
19aaeb1998-05-25Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(THIS->lval[0], T_INT, PIKE_T_FREE, integer, 0); SET_SVAL(THIS->lval[1], T_INT, PIKE_T_FREE, integer, 0);
da95392005-04-08Henrik Grubbström (Grubba)  THIS->s = NULL;
19aaeb1998-05-25Fredrik Hübinette (Hubbe) }
74dfe82012-12-30Jonas Walldén static void exit_string_assignment_storage(struct object *UNUSED(o))
19aaeb1998-05-25Fredrik Hübinette (Hubbe) { free_svalues(THIS->lval, 2, BIT_MIXED); if(THIS->s) free_string(THIS->s); }
b1f4eb1998-01-13Fredrik Hübinette (Hubbe) 
f09ec92001-02-07Henrik Grubbström (Grubba) /*! @endclass */
be478c1997-08-30Henrik Grubbström (Grubba) void init_operators(void)
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) {
408a1e2004-10-30Martin Stjernholm  ADD_EFUN ("`[..]", f_range, tOr3(tFunc(tStr tInt tRangeBound tInt tRangeBound, tStr), tFunc(tArr(tSetvar(0,tMix)) tInt tRangeBound tInt tRangeBound, tArr(tVar(0))), tFunc(tObj tMix tRangeBound tMix tRangeBound, tMix)), OPT_TRY_OPTIMIZE); ADD_INT_CONSTANT ("INDEX_FROM_BEG", INDEX_FROM_BEG, 0); ADD_INT_CONSTANT ("INDEX_FROM_END", INDEX_FROM_END, 0); ADD_INT_CONSTANT ("OPEN_BOUND", OPEN_BOUND, 0); ADD_EFUN ("`[]", f_index, tOr9(tFunc(tObj tMix tOr(tVoid,tMix), tMix), tFunc(tInt tString, tFunction),
e5ee4b2015-10-24Henrik Grubbström (Grubba)  tFunc(tNStr(tSetvar(0,tInt)) tInt, tVar(0)),
408a1e2004-10-30Martin Stjernholm  tFunc(tArr(tSetvar(0,tMix)) tMix, tVar(0)), tFunc(tMap(tMix,tSetvar(1,tMix)) tMix, tVar(1)), tFunc(tMultiset tMix, tInt01), tFunc(tPrg(tObj) tString, tMix), tFunc(tStr tInt tInt, tStr), tFunc(tArr(tSetvar(2,tMix)) tInt tInt, tArr(tVar(2)))), OPT_TRY_OPTIMIZE);
9f68471997-03-08Fredrik Hübinette (Hubbe) 
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(array(object|mapping|multiset|array),string:array(mixed))|function(object|mapping|multiset|program,string:mixed) */
8c953a2001-03-28Henrik Grubbström (Grubba)  ADD_EFUN2("`->",f_arrow,tOr(tFunc(tArr(tOr4(tObj,tMapping,tMultiset,tArray)) tStr,tArr(tMix)),tFunc(tOr4(tObj,tMapping,tMultiset,tPrg(tObj)) tStr,tMix)),OPT_TRY_OPTIMIZE,0,0);
9f68471997-03-08Fredrik Hübinette (Hubbe) 
912f171999-08-16Martin Stjernholm  ADD_EFUN("`[]=", f_index_assign,
4856a81999-08-17Martin Stjernholm  tOr4(tFunc(tObj tStr tSetvar(0,tMix)