cb22561995-10-11Fredrik Hübinette (Hubbe) /*\
06983f1996-09-22Fredrik Hübinette (Hubbe) ||| This file a part of Pike, and is copyright by Fredrik Hubinette ||| Pike is distributed as GPL (General Public License)
cb22561995-10-11Fredrik Hübinette (Hubbe) ||| See the files COPYING and DISCLAIMER for more information. \*/
8670791999-02-28Henrik Grubbström (Grubba) /**/
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "global.h"
ce4d672001-01-31Henrik Grubbström (Grubba) RCSID("$Id: builtin_functions.c,v 1.334 2001/01/31 13:27:49 grubba Exp $");
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "interpret.h" #include "svalue.h"
bb55f81997-03-16Fredrik Hübinette (Hubbe) #include "pike_macros.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "object.h" #include "program.h" #include "array.h"
b2d3e42000-12-01Fredrik Hübinette (Hubbe) #include "pike_error.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "constants.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "mapping.h" #include "stralloc.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "multiset.h" #include "pike_types.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "rusage.h" #include "operators.h" #include "fsort.h" #include "callback.h"
624d091996-02-24Fredrik Hübinette (Hubbe) #include "gc.h"
ed70b71996-06-09Fredrik Hübinette (Hubbe) #include "backend.h" #include "main.h"
9aa6fa1997-05-19Fredrik Hübinette (Hubbe) #include "pike_memory.h"
07513e1996-10-04Fredrik Hübinette (Hubbe) #include "threads.h"
3beb891996-06-21Fredrik Hübinette (Hubbe) #include "time_stuff.h"
6023ae1997-01-18Fredrik Hübinette (Hubbe) #include "version.h"
aac0151997-01-26Fredrik Hübinette (Hubbe) #include "encode.h"
3beb891996-06-21Fredrik Hübinette (Hubbe) #include <math.h>
38bddc1996-08-12Fredrik Hübinette (Hubbe) #include <ctype.h>
32a9581997-01-31Fredrik Hübinette (Hubbe) #include "module_support.h"
9c6f7d1997-04-15Fredrik Hübinette (Hubbe) #include "module.h" #include "opcodes.h"
fc33451997-10-02Fredrik Hübinette (Hubbe) #include "cyclic.h"
89b0721998-05-05Fredrik Hübinette (Hubbe) #include "signal_handler.h"
4c3d391999-01-15Fredrik Hübinette (Hubbe) #include "security.h"
c1073a1999-05-11Mirar (Pontus Hagland) #include "builtin_functions.h"
39ac731999-10-20Fredrik Noring #include "bignum.h"
6930181996-02-25Fredrik Hübinette (Hubbe) 
8bee431998-04-01Henrik Grubbström (Grubba) #ifdef HAVE_POLL
df284f1998-04-29Henrik Grubbström (Grubba) #ifdef HAVE_POLL_H
8bee431998-04-01Henrik Grubbström (Grubba) #include <poll.h>
df284f1998-04-29Henrik Grubbström (Grubba) #endif /* HAVE_POLL_H */ #ifdef HAVE_SYS_POLL_H #include <sys/poll.h> #endif /* HAVE_SYS_POLL_H */
8bee431998-04-01Henrik Grubbström (Grubba) #endif /* HAVE_POLL */
5267b71995-08-09Fredrik Hübinette (Hubbe) #ifdef HAVE_CRYPT_H #include <crypt.h> #endif
8fe8101998-03-16Henrik Grubbström (Grubba) /* #define DIFF_DEBUG */
92bb061998-05-19Henrik Grubbström (Grubba) /* #define ENABLE_DYN_DIFF */
38bddc1996-08-12Fredrik Hübinette (Hubbe) 
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int equal(mixed a, mixed b) *! *! This function checks if the values @[a] and @[b] are equal. *! *! For all types but arrays, multisets and mappings, this operation is *! the same as doing @code{@[a] == @[b]@}. *! For arrays, mappings and multisets however, their contents are checked *! recursively, and if all their contents are the same and in the same *! place, they are considered equal. *! *! @seealso *! @[copy_value()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_equal(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { int i;
7cc8311998-04-10Henrik Grubbström (Grubba)  if(args != 2)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  PIKE_ERROR("equal", "Bad number of arguments.\n", Pike_sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  i=is_equal(Pike_sp-2,Pike_sp-1);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(i); }
7535f82001-01-08Henrik Grubbström (Grubba) /*! @decl array aggregate(mixed ... elements)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! Construct an array with the arguments as indices. *! *! This function could be written in Pike as: *! @code{array aggregate(mixed ... elems) { return elems; }@} *! *! @note *! Arrays are dynamically allocated there is no need to declare them *! like int a[10]=allocate(10); (and it isn't possible either) like *! in C, just array(int) a=allocate(10); will do. *! *! @seealso *! @[sizeof()], @[arrayp()], @[allocate()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void debug_f_aggregate(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
c72a4e1998-12-15Fredrik Hübinette (Hubbe)  if(args < 0) fatal("Negative args to f_aggregate() (%d)\n",args);
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif
99946c1996-02-17Fredrik Hübinette (Hubbe)  a=aggregate_array(args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  push_array(a); /* beware, macro */ }
ce4d672001-01-31Henrik Grubbström (Grubba) /*! @decl int compat_hash(string s) *! @decl int compat_hash(string s, int max) *! *! This function will return an @tt{int@} derived from the string @[s]. *! The same string will always hash to the same value. *! If @[max] is given, the result will be >= 0 and <= @[max]. *! *! @note *! This function is provided for backward compatibility reasons. *! *! @seealso *! @[hash()] */
348cff2000-12-11Per Hedbor void f_compat_hash( INT32 args ) { struct pike_string *s = Pike_sp[-args].u.string; unsigned int i; if(!args) SIMPLE_TOO_FEW_ARGS_ERROR("hash",1); if(Pike_sp[-args].type != T_STRING) SIMPLE_BAD_ARG_ERROR("hash", 1, "string"); if( s->size_shift ) { f_hash( args ); return; } i = hashstr( (unsigned char *)s->str, MINIMUM(100,s->len)); if(args > 1) { if(Pike_sp[1-args].type != T_INT) SIMPLE_BAD_ARG_ERROR("hash",2,"int"); if(!Pike_sp[1-args].u.integer) PIKE_ERROR("hash", "Modulo by zero.\n", Pike_sp, args); i%=(unsigned INT32)Pike_sp[1-args].u.integer; } pop_n_elems(args); push_int( i ); }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
ce4d672001-01-31Henrik Grubbström (Grubba) /*! @decl int hash(string s) *! @decl int hash(string s, int max) *! *! This function will return an @tt{int@} derived from the string @[s]. *! The same string will always hash to the same value. *! If @[max] is given, the result will be >= 0 and <= @[max]. *! *! @note *! The hash algorithm was changed in Pike 7.1. If you want a hash *! that is compatible with Pike 7.0 and earlier, use @[compat_hash()]. *! *! @seealso *! @[compat_hash()] */
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_hash(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  size_t i = 0;
98d8e72000-12-10Per Hedbor  struct pike_string *s = Pike_sp[-args].u.string;
93b7202000-08-14Henrik Grubbström (Grubba) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!args)
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  SIMPLE_TOO_FEW_ARGS_ERROR("hash",1);
98d8e72000-12-10Per Hedbor 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_STRING)
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  SIMPLE_BAD_ARG_ERROR("hash", 1, "string");
f285911999-03-09Fredrik Hübinette (Hubbe) 
98d8e72000-12-10Per Hedbor  i = simple_hashmem((unsigned char *)s->str, s->len<<s->size_shift, 100<<s->size_shift);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args > 1) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[1-args].type != T_INT)
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  SIMPLE_BAD_ARG_ERROR("hash",2,"int");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(!Pike_sp[1-args].u.integer) PIKE_ERROR("hash", "Modulo by zero.\n", Pike_sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  i%=(unsigned INT32)Pike_sp[1-args].u.integer;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } pop_n_elems(args);
93b7202000-08-14Henrik Grubbström (Grubba)  push_int64(i);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl mixed copy_value(mixed value) *! *! Copy a value recursively. *! *! If the result value is changed destructively (only possible for *! multisets, arrays and mappings) the copied value will not be changed. *! *! The resulting value will always be equal to the copied (as tested with *! the function @[equal()]), but they may not the the same value (as tested *! with @[`==()]). *! *! @seealso *! @[equal()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_copy_value(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { if(!args)
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  SIMPLE_TOO_FEW_ARGS_ERROR("copy_value",1);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args-1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  copy_svalues_recursively_no_free(Pike_sp,Pike_sp-1,1,0); free_svalue(Pike_sp-1); Pike_sp[-1]=Pike_sp[0]; dmalloc_touch_svalue(Pike_sp-1);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
94d9921999-03-20Henrik Grubbström (Grubba) struct case_info { int low; /* low end of range. */ int mode; int data; }; #define CIM_NONE 0 /* Case-less */
164d671999-03-20Henrik Grubbström (Grubba) #define CIM_UPPERDELTA 1 /* Upper-case, delta to lower-case in data */ #define CIM_LOWERDELTA 2 /* Lower-case, -delta to upper-case in data */
94d9921999-03-20Henrik Grubbström (Grubba) #define CIM_CASEBIT 3 /* Some case, case mask in data */ #define CIM_CASEBITOFF 4 /* Same as above, but also offset by data */
0cb4152000-07-19Andreas Lange static const struct case_info case_info[] = {
7018811999-11-08Henrik Grubbström (Grubba) #ifdef IN_TPIKE #include "dummy_ci.h" #else /* !IN_TPIKE */
94d9921999-03-20Henrik Grubbström (Grubba) #include "case_info.h"
7018811999-11-08Henrik Grubbström (Grubba) #endif /* IN_TPIKE */
94d9921999-03-20Henrik Grubbström (Grubba)  { 0x10000, CIM_NONE, 0x0000, }, /* End sentinel. */ }; static struct case_info *find_ci(int c) { static struct case_info *cache = NULL;
5e3f721999-03-20Per Hedbor  struct case_info *ci = cache;
94d9921999-03-20Henrik Grubbström (Grubba)  int lo = 0; int hi = NELEM(case_info); if ((c < 0) || (c > 0xffff)) return NULL; if ((ci) && (ci[0].low <= c) && (ci[1].low > c)) {
480bf02000-07-27Andreas Lange  return ci;
94d9921999-03-20Henrik Grubbström (Grubba)  } while (lo != hi-1) { int mid = (lo + hi)/2; if (case_info[mid].low < c) { lo = mid; } else if (case_info[mid].low == c) { lo = mid; break; } else { hi = mid; } }
a8d36d2000-07-19Andreas Lange  return(cache = (struct case_info *)case_info + lo);
94d9921999-03-20Henrik Grubbström (Grubba) }
480bf02000-07-27Andreas Lange static struct case_info *find_ci_shift0(int c) { static struct case_info *cache = NULL; struct case_info *ci = cache; int lo = 0; int hi = CASE_INFO_SHIFT0_HIGH; if ((c < 0) || (c > 0xffff)) return NULL; if ((ci) && (ci[0].low <= c) && (ci[1].low > c)) { return ci; } while (lo != hi-1) { int mid = (lo + hi)>>1; if (case_info[mid].low < c) { lo = mid; } else if (case_info[mid].low == c) { lo = mid; break; } else { hi = mid; } } return(cache = (struct case_info *)case_info + lo); }
94d9921999-03-20Henrik Grubbström (Grubba) #define DO_LOWER_CASE(C) do {\ int c = C; \ struct case_info *ci = find_ci(c); \ if (ci) { \ switch(ci->mode) { \
164d671999-03-20Henrik Grubbström (Grubba)  case CIM_NONE: case CIM_LOWERDELTA: break; \ case CIM_UPPERDELTA: C = c + ci->data; break; \ case CIM_CASEBIT: C = c | ci->data; break; \
94d9921999-03-20Henrik Grubbström (Grubba)  case CIM_CASEBITOFF: C = ((c - ci->data) | ci->data) + ci->data; break; \ default: fatal("lower_case(): Unknown case_info mode: %d\n", ci->mode); \ } \
5e3f721999-03-20Per Hedbor  } \
94d9921999-03-20Henrik Grubbström (Grubba)  } while(0)
480bf02000-07-27Andreas Lange #define DO_LOWER_CASE_SHIFT0(C) do {\ int c = C; \ struct case_info *ci = find_ci_shift0(c); \ if (ci) { \ switch(ci->mode) { \ case CIM_NONE: case CIM_LOWERDELTA: break; \ case CIM_UPPERDELTA: C = c + ci->data; break; \ case CIM_CASEBIT: C = c | ci->data; break; \ case CIM_CASEBITOFF: C = ((c - ci->data) | ci->data) + ci->data; break; \ default: fatal("lower_case(): Unknown case_info mode: %d\n", ci->mode); \ } \ } \ } while(0)
94d9921999-03-20Henrik Grubbström (Grubba) #define DO_UPPER_CASE(C) do {\ int c = C; \ struct case_info *ci = find_ci(c); \ if (ci) { \ switch(ci->mode) { \
164d671999-03-20Henrik Grubbström (Grubba)  case CIM_NONE: case CIM_UPPERDELTA: break; \ case CIM_LOWERDELTA: C = c - ci->data; break; \ case CIM_CASEBIT: C = c & ~ci->data; break; \
94d9921999-03-20Henrik Grubbström (Grubba)  case CIM_CASEBITOFF: C = ((c - ci->data)& ~ci->data) + ci->data; break; \
93b7202000-08-14Henrik Grubbström (Grubba)  default: fatal("upper_case(): Unknown case_info mode: %d\n", ci->mode); \
94d9921999-03-20Henrik Grubbström (Grubba)  } \
5e3f721999-03-20Per Hedbor  } \
94d9921999-03-20Henrik Grubbström (Grubba)  } while(0)
480bf02000-07-27Andreas Lange #define DO_UPPER_CASE_SHIFT0(C) do {\ int c = C; \ struct case_info *ci = find_ci_shift0(c); \ if (ci) { \ switch(ci->mode) { \ case CIM_NONE: case CIM_UPPERDELTA: break; \ case CIM_LOWERDELTA: C = c - ci->data; break; \ case CIM_CASEBIT: C = c & ~ci->data; break; \ case CIM_CASEBITOFF: C = ((c - ci->data)& ~ci->data) + ci->data; break; \ default: fatal("lower_case(): Unknown case_info mode: %d\n", ci->mode); \ } \ } \ } while(0)
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string lower_case(string s) *! *! Convert a string to lower case. *! *! Returns a copy of the string @[s] with all upper case characters *! converted to lower case. *! *! @seealso *! @[upper_case()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_lower_case(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t i;
cabe031999-03-19Henrik Grubbström (Grubba)  struct pike_string *orig;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *ret;
94d9921999-03-20Henrik Grubbström (Grubba)  get_all_args("lower_case", args, "%W", &orig);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
94d9921999-03-20Henrik Grubbström (Grubba)  ret = begin_wide_shared_string(orig->len, orig->size_shift); MEMCPY(ret->str, orig->str, orig->len << orig->size_shift); i = orig->len;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
94d9921999-03-20Henrik Grubbström (Grubba)  if (!orig->size_shift) { p_wchar0 *str = STR0(ret); while(i--) {
480bf02000-07-27Andreas Lange  DO_LOWER_CASE_SHIFT0(str[i]);
94d9921999-03-20Henrik Grubbström (Grubba)  } } else if (orig->size_shift == 1) { p_wchar1 *str = STR1(ret); while(i--) { DO_LOWER_CASE(str[i]); } } else if (orig->size_shift == 2) { p_wchar2 *str = STR2(ret); while(i--) { DO_LOWER_CASE(str[i]); } } else { fatal("lower_case(): Bad string shift:%d\n", orig->size_shift); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(end_shared_string(ret)); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string upper_case(string s) *! *! Convert a string to upper case. *! *! Returns a copy of the string @[s] with all lower case characters *! converted to upper case. *! *! @seealso *! @[lower_case()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_upper_case(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t i;
cabe031999-03-19Henrik Grubbström (Grubba)  struct pike_string *orig;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *ret;
94d9921999-03-20Henrik Grubbström (Grubba)  int widen = 0; get_all_args("upper_case",args,"%W",&orig);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
5e3f721999-03-20Per Hedbor  ret=begin_wide_shared_string(orig->len,orig->size_shift);
164d671999-03-20Henrik Grubbström (Grubba)  MEMCPY(ret->str, orig->str, orig->len << orig->size_shift);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
94d9921999-03-20Henrik Grubbström (Grubba)  i = orig->len; if (!orig->size_shift) { p_wchar0 *str = STR0(ret); while(i--) {
0cb4152000-07-19Andreas Lange  if(str[i]!=0xff && str[i]!=0xb5) {
480bf02000-07-27Andreas Lange  DO_UPPER_CASE_SHIFT0(str[i]);
94d9921999-03-20Henrik Grubbström (Grubba)  } else { widen = 1; } } } else if (orig->size_shift == 1) { p_wchar1 *str = STR1(ret); while(i--) { DO_UPPER_CASE(str[i]); } } else if (orig->size_shift == 2) { p_wchar2 *str = STR2(ret); while(i--) { DO_UPPER_CASE(str[i]); } } else { fatal("lower_case(): Bad string shift:%d\n", orig->size_shift); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(end_shared_string(ret));
94d9921999-03-20Henrik Grubbström (Grubba)  if (widen) {
0cb4152000-07-19Andreas Lange  /* Widen the string, and replace any 0xb5's or 0xff's. */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  orig = Pike_sp[-1].u.string;
94d9921999-03-20Henrik Grubbström (Grubba)  ret = begin_wide_shared_string(orig->len, 1); i = orig->len; while(i--) {
0cb4152000-07-19Andreas Lange  switch(STR1(ret)[i] = STR0(orig)[i]) { case 0xff: STR1(ret)[i] = 0x178; break; case 0xb5: STR1(ret)[i] = 0x39c; break;
94d9921999-03-20Henrik Grubbström (Grubba)  } }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  free_string(Pike_sp[-1].u.string); Pike_sp[-1].u.string = end_shared_string(ret);
94d9921999-03-20Henrik Grubbström (Grubba)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int random(int max) *! *! This function returns a random number in the range 0 - @[max]-1. *! *! @seealso *! @[random_seed()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_random(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  INT_TYPE i;
67c6bd1999-10-26Henrik Grubbström (Grubba) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(args && (Pike_sp[-args].type == T_OBJECT))
8852cb1999-10-25Fredrik Hübinette (Hubbe)  { pop_n_elems(args-1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  apply(Pike_sp[-1].u.object,"_random",0);
3c002a1999-10-25Fredrik Hübinette (Hubbe)  stack_swap(); pop_stack();
8852cb1999-10-25Fredrik Hübinette (Hubbe)  return; }
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  get_all_args("random",args,"%i",&i);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  if(i <= 0)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
cabe031999-03-19Henrik Grubbström (Grubba)  i = 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{
cabe031999-03-19Henrik Grubbström (Grubba)  i = my_rand() % i;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
cabe031999-03-19Henrik Grubbström (Grubba)  pop_n_elems(args); push_int(i);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string random_string(int len) *! *! Returns a string of random characters 0-255 with the length @[len]. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_random_string(INT32 args)
283ec72000-04-15Fredrik Hübinette (Hubbe) { struct pike_string *ret;
65a5492000-08-10Per Hedbor  INT_TYPE len, e;
283ec72000-04-15Fredrik Hübinette (Hubbe)  get_all_args("random_string",args,"%i",&len); ret = begin_shared_string(len); for(e=0;e<len;e++) ret->str[e]=my_rand(); pop_n_elems(args); push_string(end_shared_string(ret)); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl void random_seed(int seed) *! *! This function sets the initial value for the random generator. *! *! @seealso *! @[random()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_random_seed(INT32 args)
cb22561995-10-11Fredrik Hübinette (Hubbe) {
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  INT_TYPE i;
e37a3e1999-10-09Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM check_all_args("random_seed",args,BIT_INT | BIT_OBJECT, 0);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type == T_INT)
ca94762000-01-09Fredrik Hübinette (Hubbe)  {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  i=Pike_sp[-args].u.integer;
ca94762000-01-09Fredrik Hübinette (Hubbe)  }else{
edf4d02000-07-06Fredrik Hübinette (Hubbe)  i=hash_svalue(Pike_sp-args);
ca94762000-01-09Fredrik Hübinette (Hubbe)  }
e37a3e1999-10-09Fredrik Hübinette (Hubbe) #else
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  get_all_args("random_seed",args,"%i",&i);
e37a3e1999-10-09Fredrik Hübinette (Hubbe) #endif
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  my_srand(i);
f6f02d1995-10-16Fredrik Hübinette (Hubbe)  pop_n_elems(args);
cb22561995-10-11Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int query_num_arg() *! *! Returns the number of arguments given when the previous function was *! called. *! *! This is useful for functions that take a variable number of arguments. *! *! @seealso *! @[call_function()] */
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_query_num_arg(INT32 args) { pop_n_elems(args);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  push_int(Pike_fp ? Pike_fp->args : 0);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int search(string haystack, string needle, int|void start) *! @decl int search(array haystack, mixed needle, int|void start) *! @decl mixed search(mapping haystack, mixed needle, mixed|void start) *! *! Search for @[needle] in @[haystack]. Return the position of @[needle] in *! @[haystack] or @tt{-1@} if not found. *! *! If the optional argument @[start] is present search is started at *! this position. *! *! When @[haystack] is a string @[needle] must be a string, and the first *! occurrence of this string is returned. *! *! When @[haystack] is an array, @[needle] is compared only to one value at *! a time in @[haystack]. *! *! When @[haystack] is a mapping, @[search()] tries to find the index *! connected to the data @[needle]. That is, it tries to lookup the mapping *! backwards. If @[needle] isn't present in the mapping, zero is returned, *! and zero_type() will return 1 for this zero. *! *! @seealso *! @[indices()], @[values()], @[zero_type()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_search(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t start;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 2)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("search", 2);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[-args].type)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_STRING: { char *ptr;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[1-args].type != T_STRING)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("search", 2, "string");
5267b71995-08-09Fredrik Hübinette (Hubbe)  start=0; if(args > 2) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[2-args].type!=T_INT)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("search", 3, "int");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  start=Pike_sp[2-args].u.integer;
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(start<0) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  bad_arg_error("search", Pike_sp-args, args, 3, "int(0..)", Pike_sp+2-args,
d0d01b1999-03-20Henrik Grubbström (Grubba)  "Start must be greater or equal to zero.\n"); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].u.string->len < start) bad_arg_error("search", Pike_sp-args, args, 1, "int(0..)", Pike_sp-args,
d0d01b1999-03-20Henrik Grubbström (Grubba)  "Start must not be greater than the " "length of the string.\n");
84f4f91998-02-27Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  start=string_search(Pike_sp[-args].u.string, Pike_sp[1-args].u.string,
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  start);
b907c82000-10-13Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args);
93b7202000-08-14Henrik Grubbström (Grubba)  push_int64(start);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; } case T_ARRAY: start=0; if(args > 2) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[2-args].type!=T_INT)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("search", 3, "int");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  start=Pike_sp[2-args].u.integer;
c2998a1999-11-08Henrik Grubbström (Grubba)  if(start<0) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  bad_arg_error("search", Pike_sp-args, args, 3, "int(0..)", Pike_sp+2-args,
c2998a1999-11-08Henrik Grubbström (Grubba)  "Start must be greater or equal to zero.\n"); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  start=array_search(Pike_sp[-args].u.array,Pike_sp+1-args,start);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args);
93b7202000-08-14Henrik Grubbström (Grubba)  push_int64(start);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING:
c2998a1999-11-08Henrik Grubbström (Grubba)  if(args > 2) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mapping_search_no_free(Pike_sp,Pike_sp[-args].u.mapping,Pike_sp+1-args,Pike_sp+2-args);
c2998a1999-11-08Henrik Grubbström (Grubba)  } else {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mapping_search_no_free(Pike_sp,Pike_sp[-args].u.mapping,Pike_sp+1-args,0);
c2998a1999-11-08Henrik Grubbström (Grubba)  }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  free_svalue(Pike_sp-args); Pike_sp[-args]=*Pike_sp; dmalloc_touch_svalue(Pike_sp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); return; default:
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("search", 1, "string|array|mapping");
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int has_prefix(string s, string prefix) *! *! Returns @tt{1@} if the string @[s] starts with @[prefix], *! returns @tt{0@} (zero) otherwise. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_has_prefix(INT32 args)
a4f17f2000-04-12Henrik Grubbström (Grubba) { struct pike_string *a, *b; get_all_args("has_prefix", args, "%W%W", &a, &b); /* First handle some common special cases. */ if ((b->len > a->len) || (b->size_shift > a->size_shift)) { pop_n_elems(args); push_int(0); return; } /* Trivial cases. */ if ((a == b)||(!b->len)) { pop_n_elems(args); push_int(1); return; } if (a->size_shift == b->size_shift) { int res = !MEMCMP(a->str, b->str, b->len << b->size_shift); pop_n_elems(args); push_int(res); return; } /* At this point a->size_shift > b->size_shift */ #define TWO_SHIFTS(S1, S2) ((S1)|((S2)<<2)) switch(TWO_SHIFTS(a->size_shift, b->size_shift)) { #define CASE_SHIFT(S1, S2) \ case TWO_SHIFTS(S1, S2): \ { \ PIKE_CONCAT(p_wchar,S1) *s1 = PIKE_CONCAT(STR,S1)(a); \ PIKE_CONCAT(p_wchar,S2) *s2 = PIKE_CONCAT(STR,S2)(b); \
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t len = b->len; \
a4f17f2000-04-12Henrik Grubbström (Grubba)  while(len-- && (s1[len] == s2[len])) \ ; \ pop_n_elems(args); \ push_int(len == -1); \ return; \ } \ break CASE_SHIFT(1,0); CASE_SHIFT(2,0); CASE_SHIFT(2,1); default:
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("has_prefix(): Unexpected string shift combination: a:%d, b:%d!\n",
a4f17f2000-04-12Henrik Grubbström (Grubba)  a->size_shift, b->size_shift); break; } #undef CASE_SHIFT #undef TWO_SHIFTS }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int has_suffix(string s, string suffix) *! *! Returns @tt{1@} if the string @[s] ends with @[suffix], *! returns @tt{0@} (zero) otherwise. */
54277b2000-12-18Henrik Grubbström (Grubba) PMOD_EXPORT void f_has_suffix(INT32 args) { struct pike_string *a, *b; get_all_args("has_suffix", args, "%W%W", &a, &b); /* First handle some common special cases. */ if ((b->len > a->len) || (b->size_shift > a->size_shift)) { pop_n_elems(args); push_int(0); return; } /* Trivial cases. */ if ((a == b)||(!b->len)) { pop_n_elems(args); push_int(1); return; } if (a->size_shift == b->size_shift) {
ce1a582000-12-18Henrik Grubbström (Grubba)  int res = !MEMCMP(a->str + ((a->len - b->len)<<b->size_shift), b->str,
54277b2000-12-18Henrik Grubbström (Grubba)  b->len << b->size_shift); pop_n_elems(args); push_int(res); return; } /* At this point a->size_shift > b->size_shift */ #define TWO_SHIFTS(S1, S2) ((S1)|((S2)<<2)) switch(TWO_SHIFTS(a->size_shift, b->size_shift)) { #define CASE_SHIFT(S1, S2) \ case TWO_SHIFTS(S1, S2): \ { \ PIKE_CONCAT(p_wchar,S1) *s1 = PIKE_CONCAT(STR,S1)(a) + a->len - b->len; \ PIKE_CONCAT(p_wchar,S2) *s2 = PIKE_CONCAT(STR,S2)(b); \ ptrdiff_t len = b->len; \ while(len-- && (s1[len] == s2[len])) \ ; \ pop_n_elems(args); \ push_int(len == -1); \ return; \ } \ break CASE_SHIFT(1,0); CASE_SHIFT(2,0); CASE_SHIFT(2,1); default: Pike_error("has_prefix(): Unexpected string shift combination: a:%d, b:%d!\n", a->size_shift, b->size_shift); break; } #undef CASE_SHIFT #undef TWO_SHIFTS }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int has_index(string haystack, int index) *! @decl int has_index(array haystack, int index) *! @decl int has_index(mapping haystack, mixed index) *! *! Search for @[index] in @[haystack]. *! *! Returns @tt{1@} if @[index] is in the index domain of @[haystack], *! or @tt{0@} (zero) if not found. *! *! This function is equivalent to (but sometimes faster than): *! *! @code{search(indices(haystack), index) != -1@} *! *! @note *! A negative index in strings and arrays as recognized by the *! index operators @tt{`[]()@} and @tt{`[]=()@} is not considered *! a proper index by @[has_index()] *! *! @seealso *! @[has_value()], @[indices()], @[search()], @[values()], @[zero_type()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_has_index(INT32 args)
538a892000-01-21Fredrik Noring { int t = 0; if(args != 2)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  PIKE_ERROR("has_index", "Bad number of arguments.\n", Pike_sp, args);
538a892000-01-21Fredrik Noring 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[-2].type)
538a892000-01-21Fredrik Noring  { case T_STRING:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-1].type == T_INT) t = (0 <= Pike_sp[-1].u.integer && Pike_sp[-1].u.integer < Pike_sp[-2].u.string->len);
538a892000-01-21Fredrik Noring  pop_n_elems(args); push_int(t); break; case T_ARRAY:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-1].type == T_INT) t = (0 <= Pike_sp[-1].u.integer && Pike_sp[-1].u.integer < Pike_sp[-2].u.array->size);
538a892000-01-21Fredrik Noring  pop_n_elems(args); push_int(t); break; case T_MULTISET: case T_MAPPING: f_index(2); f_zero_type(1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-1].type == T_INT) Pike_sp[-1].u.integer = !Pike_sp[-1].u.integer;
538a892000-01-21Fredrik Noring  else PIKE_ERROR("has_index",
edf4d02000-07-06Fredrik Hübinette (Hubbe)  "Function `zero_type' gave incorrect result.\n", Pike_sp, args);
538a892000-01-21Fredrik Noring  break; case T_OBJECT:
7b58042000-01-24Fredrik Noring  /* FIXME: If the object behaves like an array, it will throw an
a4a1722000-12-05Per Hedbor  error for non-valid indices. Therefore it's not a good idea
7b58042000-01-24Fredrik Noring  to use the index operator. Maybe we should use object->_has_index(index) provided that the object implements it.
538a892000-01-21Fredrik Noring  /Noring */ /* Fall-through. */ default: stack_swap(); f_indices(1); stack_swap(); f_search(2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-1].type == T_INT) Pike_sp[-1].u.integer = (Pike_sp[-1].u.integer != -1);
538a892000-01-21Fredrik Noring  else PIKE_ERROR("has_index",
edf4d02000-07-06Fredrik Hübinette (Hubbe)  "Function `search' gave incorrect result.\n", Pike_sp, args);
538a892000-01-21Fredrik Noring  } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int has_value(string haystack, int value) *! @decl int has_value(array haystack, int value) *! @decl int has_value(mapping haystack, mixed value) *! *! Search for @[value] in @[haystack]. *! *! Returns @tt{1@} if @[value] is in the value domain of @[haystack], *! or @tt{0@} (zero) if not found. *! *! This function is in all cases except for strings equivalent to *! (but sometimes faster than): *! *! @code{search(values(@[haystack]), @[value]) != -1@} *! *! For strings, @[has_value()] is equivalent to: *! *! @code{search(@[haystack], @[value]) != -1@} *! *! @seealso *! @[has_index()], @[indices()], @[search()], @[values()], @[zero_type()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_has_value(INT32 args)
538a892000-01-21Fredrik Noring { if(args != 2)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  PIKE_ERROR("has_value", "Bad number of arguments.\n", Pike_sp, args);
538a892000-01-21Fredrik Noring 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[-2].type)
538a892000-01-21Fredrik Noring  { case T_MAPPING: f_search(2); f_zero_type(1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-1].type == T_INT) Pike_sp[-1].u.integer = !Pike_sp[-1].u.integer;
538a892000-01-21Fredrik Noring  else PIKE_ERROR("has_value",
edf4d02000-07-06Fredrik Hübinette (Hubbe)  "Function `zero_type' gave incorrect result.\n", Pike_sp, args);
538a892000-01-21Fredrik Noring  break; case T_OBJECT: /* FIXME: It's very sad that we always have to do linear search with `values' in case of objects. The problem is that we cannot use `search' directly since it's undefined weather it returns -1 (array) or 0 (mapping) during e.g. some data type emulation.
7b58042000-01-24Fredrik Noring  Maybe we should use object->_has_value(value) provided that the object implements it.
538a892000-01-21Fredrik Noring  /Noring */ /* Fall-through. */ default: stack_swap(); f_values(1); stack_swap();
aa14882000-01-24Martin Stjernholm  case T_STRING: /* Strings are odd. /Noring */
538a892000-01-21Fredrik Noring  case T_ARRAY: f_search(2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-1].type == T_INT) Pike_sp[-1].u.integer = (Pike_sp[-1].u.integer != -1);
538a892000-01-21Fredrik Noring  else
edf4d02000-07-06Fredrik Hübinette (Hubbe)  PIKE_ERROR("has_value", "Search gave incorrect result.\n", Pike_sp, args);
538a892000-01-21Fredrik Noring  } }
9083a62000-03-08Henrik Grubbström (Grubba) /* Old backtrace */
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl array(array) backtrace() *! *! Get a description of the current call stack. *! *! The description is returned as an array with one entry for each call *! frame on the stack. *! *! Each entry has this format: *! @array
7535f82001-01-08Henrik Grubbström (Grubba)  *! @elem string file
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! A string with the filename if known, else zero.
7535f82001-01-08Henrik Grubbström (Grubba)  *! @elem int line
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! An integer containing the linenumber if known, else zero.
7535f82001-01-08Henrik Grubbström (Grubba)  *! @elem function fun
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! The function that was called at this level.
7535f82001-01-08Henrik Grubbström (Grubba)  *! @elem mixed|void ... args
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! The arguments that the function was called with. *! @endarray *! *! The current call frame will be last in the array. *! *! @note *! Please note that the frame order may be reversed in a later version *! (than 7.1) of Pike to accomodate for deferred backtraces. *! *! Note that the arguments reported in the backtrace are the current *! values of the variables, and not the ones that were at call-time. *! This can be used to hide sensitive information from backtraces *! (eg passwords). *! *! @seealso *! @[catch()], @[throw()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_backtrace(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 frames;
4218011999-01-31Fredrik Hübinette (Hubbe)  struct pike_frame *f,*of;
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct array *a,*i; frames=0; if(args) pop_n_elems(args);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  for(f=Pike_fp;f;f=f->next) frames++;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp->type=T_ARRAY; Pike_sp->u.array=a=allocate_array_no_init(frames,0); Pike_sp++;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
4218011999-01-31Fredrik Hübinette (Hubbe)  /* NOTE: The first pike_frame is ignored, since it is the call to backtrace(). */
0bd5a41997-03-10Fredrik Hübinette (Hubbe)  of=0;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  for(f=Pike_fp;f;f=(of=f)->next)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { char *program_name;
60d9872000-03-23Fredrik Hübinette (Hubbe)  debug_malloc_touch(f);
5267b71995-08-09Fredrik Hübinette (Hubbe)  frames--;
c647321997-10-21Fredrik Hübinette (Hubbe)  if(f->current_object && f->context.prog)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
0bd5a41997-03-10Fredrik Hübinette (Hubbe)  INT32 args;
4639402000-10-04Fredrik Hübinette (Hubbe)  if(!f->locals) { args=0; }else{ args=f->num_args; args = DO_NOT_WARN((INT32) MINIMUM(f->num_args, Pike_sp - f->locals)); if(of) args = DO_NOT_WARN((INT32)MINIMUM(f->num_args,of->locals - f->locals)); args=MAXIMUM(args,0); }
0bd5a41997-03-10Fredrik Hübinette (Hubbe)  ITEM(a)[frames].u.array=i=allocate_array_no_init(3+args,0);
99946c1996-02-17Fredrik Hübinette (Hubbe)  ITEM(a)[frames].type=T_ARRAY;
4639402000-10-04Fredrik Hübinette (Hubbe)  if(f->locals) assign_svalues_no_free(ITEM(i)+3, f->locals, args, BIT_MIXED);
c647321997-10-21Fredrik Hübinette (Hubbe)  if(f->current_object->prog) { ITEM(i)[2].type=T_FUNCTION; ITEM(i)[2].subtype=f->fun; ITEM(i)[2].u.object=f->current_object;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(f->current_object);
c647321997-10-21Fredrik Hübinette (Hubbe)  }else{ ITEM(i)[2].type=T_INT; ITEM(i)[2].subtype=NUMBER_DESTRUCTED; ITEM(i)[2].u.integer=0; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(f->pc) { program_name=get_line(f->pc, f->context.prog, & ITEM(i)[1].u.integer); ITEM(i)[1].subtype=NUMBER_NUMBER; ITEM(i)[1].type=T_INT; ITEM(i)[0].u.string=make_shared_string(program_name); #ifdef __CHECKER__ ITEM(i)[0].subtype=0; #endif ITEM(i)[0].type=T_STRING; }else{ ITEM(i)[1].u.integer=0; ITEM(i)[1].subtype=NUMBER_NUMBER; ITEM(i)[1].type=T_INT; ITEM(i)[0].u.integer=0; ITEM(i)[0].subtype=NUMBER_NUMBER; ITEM(i)[0].type=T_INT; } }else{
99946c1996-02-17Fredrik Hübinette (Hubbe)  ITEM(a)[frames].type=T_INT; ITEM(a)[frames].u.integer=0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
c5d9811996-05-16Fredrik Hübinette (Hubbe)  a->type_field = BIT_ARRAY | BIT_INT;
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl void add_constant(string name, mixed value) *! @decl void add_constant(string name) *! *! Add a new predefined constant. *! *! This function is often used to add builtin functions. *! All programs compiled after @[add_constant()] function has been called *! can access @[value] by the name @[name]. *! *! If there is a constant called @[name] already, it will be replaced by *! by the new definition. This will not affect already compiled programs. *! *! Calling add_constant without a value will remove that name from the list *! of constants. As with replacing, this will not affect already compiled *! programs. *! *! @seealso *! @[all_constants()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_add_constant(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
7e97c31999-01-21Fredrik Hübinette (Hubbe)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("add_constant: permission denied.\n"));
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args<1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("add_constant", 1);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type!=T_STRING)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("add_constant", 1, "string");
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args>1) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  dmalloc_touch_svalue(Pike_sp-args+1); low_add_efun(Pike_sp[-args].u.string, Pike_sp-args+1);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{
edf4d02000-07-06Fredrik Hübinette (Hubbe)  low_add_efun(Pike_sp[-args].u.string, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } pop_n_elems(args); }
dc7cc91998-01-14Fredrik Hübinette (Hubbe) #ifndef __NT__ #define IS_SEP(X) ( (X)=='/' ) #define IS_ABS(X) (IS_SEP((X)[0])?1:0) #else
df921a2000-02-28Fredrik Hübinette (Hubbe) 
dc7cc91998-01-14Fredrik Hübinette (Hubbe) #define IS_SEP(X) ( (X) == '/' || (X) == '\\' )
df921a2000-02-28Fredrik Hübinette (Hubbe)  static int find_absolute(char *s) { if(isalpha(s[0]) && s[1]==':' && IS_SEP(s[2])) return 3; if(IS_SEP(s[0]) && IS_SEP(s[1])) { int l; for(l=2;isalpha(s[l]);l++); return l; } return 0; } #define IS_ABS(X) find_absolute((X))
5a7ab61998-01-31Fredrik Hübinette (Hubbe) #define IS_ROOT(X) (IS_SEP((X)[0])?1:0)
dc7cc91998-01-14Fredrik Hübinette (Hubbe) #endif
edf4d02000-07-06Fredrik Hübinette (Hubbe) static void free_nonull(char **ptr)
6a1eca2000-06-26Fredrik Noring {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(*ptr) free(*ptr);
6a1eca2000-06-26Fredrik Noring }
5267b71995-08-09Fredrik Hübinette (Hubbe) static char *combine_path(char *cwd,char *file) { /* cwd is supposed to be combined already */ char *ret; register char *from,*to; char *my_cwd;
6a1eca2000-06-26Fredrik Noring  char *cwdbuf = 0;
df921a2000-02-28Fredrik Hübinette (Hubbe)  int tmp;
d72e8d2000-06-28Fredrik Noring  ONERROR err;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  SET_ONERROR(err, free_nonull, &cwdbuf);
0cf60f2000-03-08Henrik Grubbström (Grubba)  if((tmp=IS_ABS(file)))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
6a1eca2000-06-26Fredrik Noring  cwdbuf = (char *)xalloc(tmp+1);
df921a2000-02-28Fredrik Hübinette (Hubbe)  MEMCPY(cwdbuf,file,tmp); cwdbuf[tmp]=0;
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  cwd=cwdbuf;
df921a2000-02-28Fredrik Hübinette (Hubbe)  file+=tmp;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
5a7ab61998-01-31Fredrik Hübinette (Hubbe)  #ifdef IS_ROOT
905bb11998-01-31Fredrik Hübinette (Hubbe)  else if(IS_ROOT(file))
5a7ab61998-01-31Fredrik Hübinette (Hubbe)  {
df921a2000-02-28Fredrik Hübinette (Hubbe)  if(tmp=IS_ABS(cwd))
905bb11998-01-31Fredrik Hübinette (Hubbe)  {
6a1eca2000-06-26Fredrik Noring  cwdbuf = (char *)xalloc(tmp+1);
df921a2000-02-28Fredrik Hübinette (Hubbe)  MEMCPY(cwdbuf,cwd,tmp); cwdbuf[tmp]=0;
905bb11998-01-31Fredrik Hübinette (Hubbe)  cwd=cwdbuf; file+=IS_ROOT(file); }else{
6a1eca2000-06-26Fredrik Noring  tmp = IS_ROOT(file); cwdbuf = (char *)xalloc(tmp+1); MEMCPY(cwdbuf,file,tmp);
905bb11998-01-31Fredrik Hübinette (Hubbe)  cwdbuf[IS_ROOT(file)]=0; cwd=cwdbuf; file+=IS_ROOT(file); }
5a7ab61998-01-31Fredrik Hübinette (Hubbe)  } #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
779b2c1995-11-20Fredrik Hübinette (Hubbe)  if(!cwd) fatal("No cwd in combine_path!\n"); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) 
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(!*cwd || IS_SEP(cwd[strlen(cwd)-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { ret=(char *)xalloc(strlen(cwd)+strlen(file)+1); strcpy(ret,cwd); strcat(ret,file); }else{ ret=(char *)xalloc(strlen(cwd)+strlen(file)+2); strcpy(ret,cwd); strcat(ret,"/"); strcat(ret,file); } from=to=ret;
b603cd1997-08-26Fredrik Hübinette (Hubbe) 
df921a2000-02-28Fredrik Hübinette (Hubbe)  #ifdef __NT__ if(IS_SEP(from[0]) && IS_SEP(from[1])) *(to++)=*(from++); else #endif
b603cd1997-08-26Fredrik Hübinette (Hubbe)  /* Skip all leading "./" */
df921a2000-02-28Fredrik Hübinette (Hubbe)  while(from[0]=='.' && IS_SEP(from[1])) from+=2;
5267b71995-08-09Fredrik Hübinette (Hubbe)  while(( *to = *from )) {
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(IS_SEP(*from))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
9674d41997-11-13Fredrik Hübinette (Hubbe)  while(to>ret && to[-1]=='/') to--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(from[1] == '.') { switch(from[2]) { case '.':
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(IS_SEP(from[3]) || !from[3])
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
b603cd1997-08-26Fredrik Hübinette (Hubbe)  char *tmp=to; while(--tmp>=ret)
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(IS_SEP(*tmp))
b603cd1997-08-26Fredrik Hübinette (Hubbe)  break;
9674d41997-11-13Fredrik Hübinette (Hubbe)  tmp++;
b603cd1997-08-26Fredrik Hübinette (Hubbe) 
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(tmp[0]=='.' && tmp[1]=='.' && (IS_SEP(tmp[2]) || !tmp[2]))
b603cd1997-08-26Fredrik Hübinette (Hubbe)  break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  from+=3;
b603cd1997-08-26Fredrik Hübinette (Hubbe)  to=tmp;
5267b71995-08-09Fredrik Hübinette (Hubbe)  continue; } break; case 0:
44c89f1997-08-27Henrik Grubbström (Grubba)  case '/':
dc7cc91998-01-14Fredrik Hübinette (Hubbe) #ifdef __NT__ case '\\': #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  from+=2; continue; } } } from++; to++; }
9674d41997-11-13Fredrik Hübinette (Hubbe) 
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(*ret && !IS_SEP(from[-1]) && IS_SEP(to[-1]))
2b5d7f1997-11-16Fredrik Hübinette (Hubbe)  *--to=0;
9674d41997-11-13Fredrik Hübinette (Hubbe) 
b603cd1997-08-26Fredrik Hübinette (Hubbe)  if(!*ret) {
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(IS_SEP(*cwd))
b603cd1997-08-26Fredrik Hübinette (Hubbe)  { ret[0]='/'; ret[1]=0; }else{ ret[0]='.'; ret[1]=0; } }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
6a1eca2000-06-26Fredrik Noring  CALL_AND_UNSET_ONERROR(err);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string combine_path(string absolute, string relative) *! *! Concatenate a relative path to an absolute path and remove any *! @tt{"//"@}, @tt{"/.."@} or @tt{"/."@} to produce a straightforward *! absolute path as a result. *! *! @seealso *! @[getcwd()], @[Stdio.append_path()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_combine_path(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
05459a1998-04-09Fredrik Hübinette (Hubbe)  char *path=0; int e,dofree=0; struct pike_string *ret; if(args<1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("combine_path", 1);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_STRING)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("combine_path", 1, "string");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  path=Pike_sp[-args].u.string->str;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
05459a1998-04-09Fredrik Hübinette (Hubbe)  for(e=1;e<args;e++) { char *newpath;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[e-args].type != T_STRING)
05459a1998-04-09Fredrik Hübinette (Hubbe)  { if(dofree) free(path);
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("combine_path", e+1, "string");
05459a1998-04-09Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  newpath=combine_path(path,Pike_sp[e-args].u.string->str);
05459a1998-04-09Fredrik Hübinette (Hubbe)  if(dofree) free(path); path=newpath; dofree=1; } ret=make_shared_string(path); if(dofree) free(path); pop_n_elems(args); push_string(ret);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl object function_object(function f) *! *! Return the object the function @[f] is in. *! *! If @[f] is a global function defined in the runtime @tt{0@} (zero) *! will be returned. *! *! @seealso *! @[function_name()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_function_object(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { if(args < 1)
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  SIMPLE_TOO_FEW_ARGS_ERROR("function_object",1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_FUNCTION)
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  SIMPLE_BAD_ARG_ERROR("function_object",1,"function");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].subtype == FUNCTION_BUILTIN)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0); }else{ pop_n_elems(args-1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp[-1].type=T_OBJECT;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string function_name(function f) *! *! Return the name of the function @[f]. *! *! If @[f] is a global function defined in the runtime @tt{0@} (zero) *! will be returned. *! *! @seealso *! @[function_object()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_function_name(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("function_name", 1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_FUNCTION)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("function_name", 1, "function");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].subtype == FUNCTION_BUILTIN)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0); }else{
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(!Pike_sp[-args].u.object->prog) bad_arg_error("function_name", Pike_sp-args, args, 1, "function", Pike_sp-args,
d0d01b1999-03-20Henrik Grubbström (Grubba)  "Destructed object.\n");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  copy_shared_string(s,ID_FROM_INT(Pike_sp[-args].u.object->prog, Pike_sp[-args].subtype)->name);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp->type=T_STRING; Pike_sp->u.string=s; Pike_sp++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int zero_type(mixed a) *! *! Return the type of zero. *! *! There are many types of zeros out there, or at least there are two. *! One is returned by normal functions, and one returned by mapping *! lookups and find_call_out() when what you looked for wasn't there. *! The only way to separate these two kinds of zeros is @[zero_type()]. *! *! When doing a @[find_call_out()] or mapping lookup, @[zero_type()] on *! this value will return @tt{1@} if there was no such thing present in *! the mapping, or no such @tt{call_out@} could be found. *! *! If the argument to @[zero_type()] is a destructed object or a function *! in a destructed object, @tt{2@} will be returned. *! *! In all other cases @[zero_type()] will return @tt{0@} (zero). *! *! @seealso *! @[fund_call_out()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_zero_type(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { if(args < 1)
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  SIMPLE_TOO_FEW_ARGS_ERROR("zero_type",1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_INT)
3f6d8f1996-11-26Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  else if((Pike_sp[-args].type==T_OBJECT || Pike_sp[-args].type==T_FUNCTION) && !Pike_sp[-args].u.object->prog)
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(NUMBER_DESTRUCTED); } {
3f6d8f1996-11-26Fredrik Hübinette (Hubbe)  pop_n_elems(args-1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp[-1].u.integer=Pike_sp[-1].subtype; Pike_sp[-1].subtype=NUMBER_NUMBER;
3f6d8f1996-11-26Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
4643ea1998-10-10Henrik Grubbström (Grubba) /* * Some wide-strings related functions */
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string string_to_unicode(string s) *! *! Converts a string into an UTF16 compliant byte-stream. *! *! @note *! Throws an error if characters not legal in an UTF16 stream are encountered. *! Valid characters are in the range 0x00000 - 0x10ffff, except for characters *! 0xfffe and 0xffff. *! *! Characters in range 0x010000 - 0x10ffff are encoded using surrogates. *! *! @seealso *! @[Locale.Charset.decode()], @[string_to_utf8()], @[unicode_to_string()], *! @[utf8_to_string()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_string_to_unicode(INT32 args)
4643ea1998-10-10Henrik Grubbström (Grubba) { struct pike_string *in; struct pike_string *out = NULL;
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t len; ptrdiff_t i;
4643ea1998-10-10Henrik Grubbström (Grubba) 
1d8bb01998-10-10Henrik Grubbström (Grubba)  get_all_args("string_to_unicode", args, "%W", &in);
4643ea1998-10-10Henrik Grubbström (Grubba)  switch(in->size_shift) { case 0: /* Just 8bit characters */ len = in->len * 2; out = begin_shared_string(len);
89a70c2000-08-28Henrik Grubbström (Grubba)  if (len) { MEMSET(out->str, 0, len); /* Clear the upper (and lower) byte */ #ifdef PIKE_DEBUG if (d_flag) { for(i = len; i--;) { if (out->str[i]) {
d1cac52000-09-07Henrik Grubbström (Grubba)  fatal("MEMSET didn't clear byte %ld of %ld\n", PTRDIFF_T_TO_LONG(i+1), PTRDIFF_T_TO_LONG(len));
89a70c2000-08-28Henrik Grubbström (Grubba)  } } } #endif /* PIKE_DEBUG */ for(i = in->len; i--;) { out->str[i * 2 + 1] = in->str[i]; }
4643ea1998-10-10Henrik Grubbström (Grubba)  } out = end_shared_string(out); break; case 1: /* 16 bit characters */ /* FIXME: Should we check for 0xfffe & 0xffff here too? */ len = in->len * 2; out = begin_shared_string(len);
71f3a21998-11-22Fredrik Hübinette (Hubbe) #if (PIKE_BYTEORDER == 4321)
4643ea1998-10-10Henrik Grubbström (Grubba)  /* Big endian -- We don't need to do much... * * FIXME: Future optimization: Check if refcount is == 1, * and perform sufficient magic to be able to convert in place. */ MEMCPY(out->str, in->str, len); #else /* Other endianness, may need to do byte-order conversion also. */ { p_wchar1 *str1 = STR1(in); for(i = in->len; i--;) { unsigned INT32 c = str1[i];
7156611998-10-15Henrik Grubbström (Grubba)  out->str[i * 2 + 1] = c & 0xff;
66b11d1998-10-15Henrik Grubbström (Grubba)  out->str[i * 2] = c >> 8;
4643ea1998-10-10Henrik Grubbström (Grubba)  } } #endif out = end_shared_string(out); break; case 2: /* 32 bit characters -- Is someone writing in Klingon? */ { p_wchar2 *str2 = STR2(in);
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t j;
01c1081998-10-10Henrik Grubbström (Grubba)  len = in->len * 2;
4643ea1998-10-10Henrik Grubbström (Grubba)  /* Check how many extra wide characters there are. */ for(i = in->len; i--;) { if (str2[i] > 0xfffd) { if (str2[i] < 0x10000) { /* 0xfffe: Byte-order detection illegal character. * 0xffff: Illegal character. */
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("string_to_unicode(): Illegal character 0x%04x (index %ld) "
69bb402000-08-17Henrik Grubbström (Grubba)  "is not a Unicode character.", str2[i], PTRDIFF_T_TO_LONG(i));
4643ea1998-10-10Henrik Grubbström (Grubba)  } if (str2[i] > 0x10ffff) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("string_to_unicode(): Character 0x%08x (index %ld) "
69bb402000-08-17Henrik Grubbström (Grubba)  "is out of range (0x00000000 - 0x0010ffff).", str2[i], PTRDIFF_T_TO_LONG(i));
4643ea1998-10-10Henrik Grubbström (Grubba)  } /* Extra wide characters take two unicode characters in space. * ie One unicode character extra. */ len += 2; } } out = begin_shared_string(len);
01c1081998-10-10Henrik Grubbström (Grubba)  j = len;
4643ea1998-10-10Henrik Grubbström (Grubba)  for(i = in->len; i--;) { unsigned INT32 c = str2[i]; j -= 2; if (c > 0xffff) { /* Use surrogates */ c -= 0x10000; out->str[j + 1] = c & 0xff; out->str[j] = 0xdc | ((c >> 8) & 0x03); j -= 2; c >>= 10; c |= 0xd800; } out->str[j + 1] = c & 0xff; out->str[j] = c >> 8; }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
4643ea1998-10-10Henrik Grubbström (Grubba)  if (j) {
a4a1722000-12-05Per Hedbor  fatal("string_to_unicode(): Indexing error: len:%ld, j:%ld.\n",
69bb402000-08-17Henrik Grubbström (Grubba)  PTRDIFF_T_TO_LONG(len), PTRDIFF_T_TO_LONG(j));
4643ea1998-10-10Henrik Grubbström (Grubba)  }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
4643ea1998-10-10Henrik Grubbström (Grubba)  out = end_shared_string(out); } break; default:
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("string_to_unicode(): Bad string shift: %d!\n", in->size_shift);
4643ea1998-10-10Henrik Grubbström (Grubba)  break; } pop_n_elems(args); push_string(out); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string unicode_to_string(string s) *! *! Converts an UTF16 byte-stream into a string. *! *! @note *! This function does not decode surrogates. *! *! @seealso *! @[Locale.Charset.decode()], @[string_to_unicode()], @[string_to_utf8()], *! @[utf8_to_string()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_unicode_to_string(INT32 args)
4643ea1998-10-10Henrik Grubbström (Grubba) { struct pike_string *in; struct pike_string *out = NULL;
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t len;
4643ea1998-10-10Henrik Grubbström (Grubba)  get_all_args("unicode_to_string", args, "%S", &in); if (in->len & 1) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  bad_arg_error("unicode_to_string", Pike_sp-args, args, 1, "string", Pike_sp-args,
d0d01b1999-03-20Henrik Grubbström (Grubba)  "String length is odd.\n");
4643ea1998-10-10Henrik Grubbström (Grubba)  } /* FIXME: In the future add support for decoding of surrogates. */ len = in->len / 2;
1e45331998-10-10Henrik Grubbström (Grubba)  out = begin_wide_shared_string(len, 1);
71f3a21998-11-22Fredrik Hübinette (Hubbe) #if (PIKE_BYTEORDER == 4321)
4643ea1998-10-10Henrik Grubbström (Grubba)  /* Big endian * * FIXME: Future optimization: Perform sufficient magic * to do the conversion in place if the ref-count is == 1. */
1e45331998-10-10Henrik Grubbström (Grubba)  MEMCPY(out->str, in->str, in->len);
4643ea1998-10-10Henrik Grubbström (Grubba) #else /* Little endian */ {
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t i;
4643ea1998-10-10Henrik Grubbström (Grubba)  p_wchar1 *str1 = STR1(out); for (i = len; i--;) {
66b11d1998-10-15Henrik Grubbström (Grubba)  str1[i] = (((unsigned char *)in->str)[i*2]<<8) + ((unsigned char *)in->str)[i*2 + 1];
4643ea1998-10-10Henrik Grubbström (Grubba)  } }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_BYTEORDER == 4321 */
4643ea1998-10-10Henrik Grubbström (Grubba)  out = end_shared_string(out); pop_n_elems(args); push_string(out); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string string_to_utf8(string s) *! @decl string string_to_utf8(string s, int extended) *! *! Converts a string into an UTF8 compliant byte-stream. *! *! @note *! Throws an error if characters not valid in an UTF8 stream are encountered. *! Valid characters are in the range 0x00000000 - 0x7fffffff. *!
7535f82001-01-08Henrik Grubbström (Grubba)  *! If @[extended] is 1, characters in the range 0x80000000-0xfffffffff
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! will also be accepted, and encoded using a non-standard UTF8 extension. *! *! @seealso *! @[Locale.Charset.decode()], @[string_to_unicode()], @[unicode_to_string()] *! @[utf8_to_string()] */
be40771998-10-15Henrik Grubbström (Grubba) void f_string_to_utf8(INT32 args) {
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t len;
be40771998-10-15Henrik Grubbström (Grubba)  struct pike_string *in; struct pike_string *out;
69bb402000-08-17Henrik Grubbström (Grubba)  ptrdiff_t i,j;
be40771998-10-15Henrik Grubbström (Grubba)  int extended = 0; get_all_args("string_to_utf8", args, "%W", &in); if (args > 1) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[1-args].type != T_INT) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("string_to_utf8", 2, "int|void");
be40771998-10-15Henrik Grubbström (Grubba)  }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  extended = Pike_sp[1-args].u.integer;
be40771998-10-15Henrik Grubbström (Grubba)  } len = in->len; for(i=0; i < in->len; i++) { unsigned INT32 c = index_shared_string(in, i); if (c & ~0x7f) { /* 8bit or more. */ len++; if (c & ~0x7ff) { /* 12bit or more. */ len++; if (c & ~0xffff) { /* 17bit or more. */ len++; if (c & ~0x1fffff) { /* 22bit or more. */ len++; if (c & ~0x3ffffff) { /* 27bit or more. */ len++; if (c & ~0x7fffffff) { /* 32bit or more. */
cf03f91998-10-31Henrik Grubbström (Grubba)  if (!extended) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("string_to_utf8(): "
d1cac52000-09-07Henrik Grubbström (Grubba)  "Value 0x%08x (index %ld) is larger than 31 bits.\n", c, PTRDIFF_T_TO_LONG(i));
cf03f91998-10-31Henrik Grubbström (Grubba)  }
be40771998-10-15Henrik Grubbström (Grubba)  len++; /* FIXME: Needs fixing when we get 64bit chars... */ } } } } } } } if (len == in->len) {
8e3f351998-10-23Henrik Grubbström (Grubba)  /* 7bit string -- already valid utf8. */
be40771998-10-15Henrik Grubbström (Grubba)  pop_n_elems(args - 1); return; } out = begin_shared_string(len); for(i=j=0; i < in->len; i++) { unsigned INT32 c = index_shared_string(in, i); if (!(c & ~0x7f)) { /* 7bit */ out->str[j++] = c; } else if (!(c & ~0x7ff)) { /* 11bit */ out->str[j++] = 0xc0 | (c >> 6); out->str[j++] = 0x80 | (c & 0x3f); } else if (!(c & ~0xffff)) { /* 16bit */ out->str[j++] = 0xe0 | (c >> 12); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } else if (!(c & ~0x1fffff)) { /* 21bit */ out->str[j++] = 0xf0 | (c >> 18); out->str[j++] = 0x80 | ((c >> 12) & 0x3f); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } else if (!(c & ~0x3ffffff)) { /* 26bit */ out->str[j++] = 0xf8 | (c >> 24); out->str[j++] = 0x80 | ((c >> 18) & 0x3f); out->str[j++] = 0x80 | ((c >> 12) & 0x3f); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } else if (!(c & ~0x7fffffff)) { /* 31bit */ out->str[j++] = 0xfc | (c >> 30); out->str[j++] = 0x80 | ((c >> 24) & 0x3f); out->str[j++] = 0x80 | ((c >> 18) & 0x3f); out->str[j++] = 0x80 | ((c >> 12) & 0x3f); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } else {
ed65901998-10-31Henrik Grubbström (Grubba)  /* This and onwards is extended UTF-8 encoding. */
be40771998-10-15Henrik Grubbström (Grubba)  /* 32 - 36bit */ out->str[j++] = 0xfe; out->str[j++] = 0x80 | ((c >> 30) & 0x3f); out->str[j++] = 0x80 | ((c >> 24) & 0x3f); out->str[j++] = 0x80 | ((c >> 18) & 0x3f); out->str[j++] = 0x80 | ((c >> 12) & 0x3f); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
be40771998-10-15Henrik Grubbström (Grubba)  if (len != j) {
69bb402000-08-17Henrik Grubbström (Grubba)  fatal("string_to_utf8(): Calculated and actual lengths differ: " "%ld != %ld\n", PTRDIFF_T_TO_LONG(len), PTRDIFF_T_TO_LONG(j));
be40771998-10-15Henrik Grubbström (Grubba)  }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
be40771998-10-15Henrik Grubbström (Grubba)  out = end_shared_string(out); pop_n_elems(args); push_string(out); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string utf8_to_string(string s) *! @decl string utf8_to_string(string s, int extended) *! *! Converts an UTF8 byte-stream into a string. *! *! @note *! Throws an error if the stream is not a legal UFT8 byte-stream. *! *! Accepts and decodes the extension used by @[string_to_utf8()], if *! @[extended] is @tt{1@}. *! *! @seealso *! @[Locale.Charset.decode()], @[string_to_unicode()], @[string_to_utf8()], *! @[unicode_to_string()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_utf8_to_string(INT32 args)
be40771998-10-15Henrik Grubbström (Grubba) { struct pike_string *in; struct pike_string *out; int len = 0; int shift = 0; int i,j;
ed65901998-10-31Henrik Grubbström (Grubba)  int extended = 0;
be40771998-10-15Henrik Grubbström (Grubba)  get_all_args("utf8_to_string", args, "%S", &in);
ed65901998-10-31Henrik Grubbström (Grubba)  if (args > 1) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[1-args].type != T_INT) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("utf8_to_string()", 2, "int|void");
ed65901998-10-31Henrik Grubbström (Grubba)  }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  extended = Pike_sp[1-args].u.integer;
ed65901998-10-31Henrik Grubbström (Grubba)  }
be40771998-10-15Henrik Grubbström (Grubba)  for(i=0; i < in->len; i++) { unsigned int c = ((unsigned char *)in->str)[i]; len++; if (c & 0x80) { int cont = 0; if ((c & 0xc0) == 0x80) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("utf8_to_string(): "
be40771998-10-15Henrik Grubbström (Grubba)  "Unexpected continuation block 0x%02x at index %d.\n", c, i); } if ((c & 0xe0) == 0xc0) { /* 11bit */ cont = 1; if (c & 0x1c) { if (shift < 1) { shift = 1; } } } else if ((c & 0xf0) == 0xe0) { /* 16bit */ cont = 2; if (shift < 1) { shift = 1; } } else { shift = 2; if ((c & 0xf8) == 0xf0) { /* 21bit */ cont = 3; } else if ((c & 0xfc) == 0xf8) { /* 26bit */ cont = 4; } else if ((c & 0xfe) == 0xfc) { /* 31bit */ cont = 5; } else if (c == 0xfe) { /* 36bit */
ed65901998-10-31Henrik Grubbström (Grubba)  if (!extended) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("utf8_to_string(): "
ed65901998-10-31Henrik Grubbström (Grubba)  "Character 0xfe at index %d when not in extended mode.\n", i); }
be40771998-10-15Henrik Grubbström (Grubba)  cont = 6; } else {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("utf8_to_string(): "
be40771998-10-15Henrik Grubbström (Grubba)  "Unexpected character 0xff at index %d.\n", i); } } while(cont--) { i++; if (i >= in->len) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("utf8_to_string(): Truncated UTF8 sequence.\n");
be40771998-10-15Henrik Grubbström (Grubba)  } c = ((unsigned char *)(in->str))[i]; if ((c & 0xc0) != 0x80) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("utf8_to_string(): "
be40771998-10-15Henrik Grubbström (Grubba)  "Expected continuation character at index %d (got 0x%02x).\n", i, c); } } } } if (len == in->len) { /* 7bit in == 7bit out */ pop_n_elems(args-1); return; } out = begin_wide_shared_string(len, shift); for(j=i=0; i < in->len; i++) { unsigned int c = ((unsigned char *)in->str)[i]; if (c & 0x80) { int cont = 0; /* NOTE: The tests aren't as paranoid here, since we've * already tested the string above. */ if ((c & 0xe0) == 0xc0) { /* 11bit */ cont = 1; c &= 0x1f; } else if ((c & 0xf0) == 0xe0) { /* 16bit */ cont = 2; c &= 0x0f; } else if ((c & 0xf8) == 0xf0) { /* 21bit */ cont = 3; c &= 0x07; } else if ((c & 0xfc) == 0xf8) { /* 26bit */ cont = 4; c &= 0x03; } else if ((c & 0xfe) == 0xfc) { /* 31bit */ cont = 5; c &= 0x01; } else { /* 36bit */ cont = 6; c = 0; } while(cont--) { unsigned INT32 c2 = ((unsigned char *)(in->str))[++i] & 0x3f; c = (c << 6) | c2; } } low_set_index(out, j++, c); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
be40771998-10-15Henrik Grubbström (Grubba)  if (j != len) { fatal("utf8_to_string(): Calculated and actual lengths differ: %d != %d\n", len, j); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
be40771998-10-15Henrik Grubbström (Grubba)  out = end_shared_string(out); pop_n_elems(args); push_string(out); }
7535f82001-01-08Henrik Grubbström (Grubba) /*! @decl string __parse_pike_type(string t)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
aa0bdf1999-11-08Per Hedbor static void f_parse_pike_type( INT32 args ) { struct pike_string *res;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if( Pike_sp[-1].type != T_STRING || Pike_sp[-1].u.string->size_shift )
9c1a7b2001-01-08Henrik Grubbström (Grubba)  Pike_error( "__parse_pike_type requires a 8bit string as its first argument\n" );
edf4d02000-07-06Fredrik Hübinette (Hubbe)  res = parse_type( (char *)STR0(Pike_sp[-1].u.string) );
aa0bdf1999-11-08Per Hedbor  pop_stack(); push_string( res ); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl mapping (string:mixed) all_constant() *! *! Returns a mapping containing all global constants, indexed on the name *! of the constant, and with the value of the constant as value. *! *! @seealso *! @[add_constant()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_all_constants(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { pop_n_elems(args);
0e88611998-04-16Fredrik Hübinette (Hubbe)  ref_push_mapping(get_builtin_constants());
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl array allocate(int size) *! @decl array allocate(int size, mixed zero) *! *! Allocate an array of @[size] elements and initialize them to @[zero]. *! *! @seealso *! @[sizeof()], @[aggregate()], @[arrayp()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_allocate(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 size;
8267f41998-01-28Fredrik Hübinette (Hubbe)  struct array *a;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 1)
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  SIMPLE_TOO_FEW_ARGS_ERROR("allocate",1);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type!=T_INT)
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  SIMPLE_BAD_ARG_ERROR("allocate",1,"int");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  size=Pike_sp[-args].u.integer;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(size < 0)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  PIKE_ERROR("allocate", "Can't allocate array of negative size.\n", Pike_sp, args);
8267f41998-01-28Fredrik Hübinette (Hubbe)  a=allocate_array(size); if(args>1) { INT32 e; for(e=0;e<a->size;e++)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  copy_svalues_recursively_no_free(a->item+e, Pike_sp-args+1, 1, 0);
8267f41998-01-28Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args);
8267f41998-01-28Fredrik Hübinette (Hubbe)  push_array(a);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl array(int) rusage() *! *! Return resource usage. *! *! Returns an array of ints describing how much resources the interpreter *! process has used so far. This array will have at least 29 elements, of *! which those values not available on this system will be zero. *! *! The elements are as follows: *! @array
7535f82001-01-08Henrik Grubbström (Grubba)  *! @elem int user_time *! @elem int system_time *! @elem int maxrss *! @elem int idrss *! @elem int isrss *! @elem int minflt *! @elem int minor_page_faults *! @elem int major_page_faults *! @elem int swaps *! @elem int block_input_op *! @elem int block_output_op *! @elem int messages_sent *! @elem int messages_received *! @elem int signals_received *! @elem int voluntary_context_switches *! @elem int involuntary_context_switches *! @elem int sysc *! @elem int ioch *! @elem int rtime *! @elem int ttime *! @elem int tftime *! @elem int dftime *! @elem int dftime *! @elem int ltime *! @elem int slptime *! @elem int wtime *! @elem int stoptime *! @elem int brksize *! @elem int stksize
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! @endarray *! *! The values will not be further explained here; read your system manual *! for more information. *! *! @note *! All values may not be present on all systems. *! *! @seealso *! @[time()] */
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_rusage(INT32 args) {
99946c1996-02-17Fredrik Hübinette (Hubbe)  INT32 *rus,e;
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct array *v; pop_n_elems(args); rus=low_rusage(); if(!rus)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  PIKE_ERROR("rusage", "System rusage information not available.\n", Pike_sp, args);
99946c1996-02-17Fredrik Hübinette (Hubbe)  v=allocate_array_no_init(29,0); for(e=0;e<29;e++) { ITEM(v)[e].type=T_INT; ITEM(v)[e].subtype=NUMBER_NUMBER; ITEM(v)[e].u.integer=rus[e]; }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp->u.array=v; Pike_sp->type=T_ARRAY; Pike_sp++;
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl object this_object(); *! *! Returns the object we are currently evaluating in. */
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_this_object(INT32 args) { pop_n_elems(args);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_fp)
cb22561995-10-11Fredrik Hübinette (Hubbe)  {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ref_push_object(Pike_fp->current_object);
cb22561995-10-11Fredrik Hübinette (Hubbe)  }else{ push_int(0); }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
b62ab01999-12-12Henrik Grubbström (Grubba) node *fix_this_object_type(node *n) { free_string(n->type); type_stack_mark();
bad5162000-06-23Fredrik Hübinette (Hubbe)  push_type_int(Pike_compiler->new_program->id);
2f965a1999-12-12Per Hedbor  /* push_type(1); We are rather sure that we contain ourselves... */ push_type(0); /* But it did not work yet, so... */
b62ab01999-12-12Henrik Grubbström (Grubba)  push_type(T_OBJECT); n->type = pop_unfinished_type(); if (n->parent) { n->parent->node_info |= OPT_TYPE_NOT_FIXED; } return NULL; }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl void throw(mixed value) *! *! Throw @[value] to a waiting @[catch]. *! *! If no @[catch] is waiting the global error handling will send the *! value to @[master()->handle_error()]. *! *! If you throw an array with where the first index contains an error *! message and the second index is a backtrace, (the output from *! @[backtrace()]) then it will be treated exactly like a real error *! by overlying functions. *! *! @seealso *! @[catch] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_throw(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("throw", 1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  assign_svalue(&throw_value,Pike_sp-args);
864d3c1998-01-29Fredrik Hübinette (Hubbe)  pop_n_elems(args);
641d5c1998-04-09Fredrik Hübinette (Hubbe)  throw_severity=0;
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  pike_throw();
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl void exit(int returncode) *! *! Exit the whole Pike program with the given @[returncode]. *! *! Using @[exit()] with any other value than @tt{0@} (zero) indicates that *! something went wrong during execution. See your system manuals for *! more information about return codes. *! *! @seealso *! @[_exit()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_exit(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
b4c5de1999-03-25Fredrik Hübinette (Hubbe)  static int in_exit=0;
7e97c31999-01-21Fredrik Hübinette (Hubbe)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("exit: permission denied.\n"));
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("exit", 1);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_INT)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("exit", 1, "int");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  if(in_exit) Pike_error("exit already called!\n");
b4c5de1999-03-25Fredrik Hübinette (Hubbe)  in_exit=1;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  assign_svalue(&throw_value, Pike_sp-args);
61e9a01998-01-25Fredrik Hübinette (Hubbe)  throw_severity=THROW_EXIT; pike_throw();
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl void _exit(int returncode) *! *! This function does the same as @[exit], but doesn't bother to clean *! up the Pike interpreter before exiting. This means that no destructors *! will be called, caches will not be flushed, file locks might not be *! released, and databases might not be closed properly. *! *! Use with extreme caution. *! *! @seealso *! @[exit()] */
608d731998-03-20Fredrik Hübinette (Hubbe) void f__exit(INT32 args) {
7e97c31999-01-21Fredrik Hübinette (Hubbe)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_exit: permission denied.\n"));
608d731998-03-20Fredrik Hübinette (Hubbe)  if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("_exit", 1);
608d731998-03-20Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_INT)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("_exit", 1, "int");
608d731998-03-20Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  exit(Pike_sp[-args].u.integer);
608d731998-03-20Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int time(); *! @decl int time(int(1..1) one) *! @decl float time(int(2..) t) *! *! This function returns the number of seconds since 1 Jan 1970. *! *! The second syntax does not call the system call @tt{time()@} as often, *! but is only updated in the backed (when Pike code isn't running). *! *! The third syntax can be used to measure time more preciely than one second. *! It return how many seconds has passed since @[t]. The precision of this *! function varies from system to system. *! *! @seealso *! @[ctime()], @[localtime()], @[mktime()], @[gmtime()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_time(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
7b52a01998-03-10Henrik Grubbström (Grubba)  if(!args)
d0e6741998-07-15Fredrik Hübinette (Hubbe)  {
7b52a01998-03-10Henrik Grubbström (Grubba)  GETTIMEOFDAY(&current_time);
d0e6741998-07-15Fredrik Hübinette (Hubbe)  }else{
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type == T_INT && Pike_sp[-args].u.integer > 1)
d0e6741998-07-15Fredrik Hübinette (Hubbe)  { struct timeval tmp; GETTIMEOFDAY(&current_time);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  tmp.tv_sec=Pike_sp[-args].u.integer;
d0e6741998-07-15Fredrik Hübinette (Hubbe)  tmp.tv_usec=0; my_subtract_timeval(&tmp,&current_time); pop_n_elems(args);
65a5492000-08-10Per Hedbor  push_float( - (FLOAT_TYPE)tmp.tv_sec-((FLOAT_TYPE)tmp.tv_usec)/1000000 );
d0e6741998-07-15Fredrik Hübinette (Hubbe)  return; } } pop_n_elems(args);
7b52a01998-03-10Henrik Grubbström (Grubba)  push_int(current_time.tv_sec);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string crypt(string password) *! @decl int(0..1) crypt(string typed_password, string crypted_password) *! *! This function crypts and verifies a short string (only the first *! 8 characters are significant). *! *! The first syntax crypts the string @[password] into something that *! is hopefully hard to decrypt. *! *! The second syntax is used to verify @[typed_password] against *! @[crypted_password], and returns @tt{1@} if they match, and @tt{0@} *! (zero) otherwise. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_crypt(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { char salt[2];
8beaf71996-04-13Fredrik Hübinette (Hubbe)  char *ret, *saltp;
5267b71995-08-09Fredrik Hübinette (Hubbe)  char *choise = "cbhisjKlm4k65p7qrJfLMNQOPxwzyAaBDFgnoWXYCZ0123tvdHueEGISRTUV89./"; if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("crypt", 1);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_STRING)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("crypt", 1, "string");
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args>1) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[1-args].type != T_STRING || Pike_sp[1-args].u.string->len < 2)
0f6deb1997-08-06Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0); return; }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  saltp=Pike_sp[1-args].u.string->str;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } else {
99e2121996-09-23Fredrik Hübinette (Hubbe)  unsigned int foo; /* Sun CC want's this :( */ foo=my_rand();
93b7202000-08-14Henrik Grubbström (Grubba)  salt[0] = choise[foo % (size_t) strlen(choise)];
99e2121996-09-23Fredrik Hübinette (Hubbe)  foo=my_rand();
93b7202000-08-14Henrik Grubbström (Grubba)  salt[1] = choise[foo % (size_t) strlen(choise)];
8beaf71996-04-13Fredrik Hübinette (Hubbe)  saltp=salt;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } #ifdef HAVE_CRYPT
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ret = (char *)crypt(Pike_sp[-args].u.string->str, saltp);
5267b71995-08-09Fredrik Hübinette (Hubbe) #else #ifdef HAVE__CRYPT
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ret = (char *)_crypt(Pike_sp[-args].u.string->str, saltp);
5267b71995-08-09Fredrik Hübinette (Hubbe) #else
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ret = Pike_sp[-args].u.string->str;
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif #endif if(args < 2) { pop_n_elems(args); push_string(make_shared_string(ret)); }else{ int i;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  i=!strcmp(ret,Pike_sp[1-args].u.string->str);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(i); } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl void destruct(object o) *! *! Mark an object as destructed. *! *! Calls @tt{o->destroy()@}, and then clears all varaibles in the object. *! *! All pointers and function pointers to this object will become zero. *! The destructed object will be freed from memory as soon as possible. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_destruct(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct object *o; if(args) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_OBJECT)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("destruct", 1, "object");
e99c7a1999-10-29Martin Stjernholm 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  o=Pike_sp[-args].u.object;
cb22561995-10-11Fredrik Hübinette (Hubbe)  }else{
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(!Pike_fp) PIKE_ERROR("destruct", "Destruct called without argument from callback function.\n", Pike_sp, args);
cb22561995-10-11Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  o=Pike_fp->current_object;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
4d6d781999-11-14Martin Stjernholm  if (o->prog && o->prog->flags & PROGRAM_NO_EXPLICIT_DESTRUCT)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  PIKE_ERROR("destruct", "Object can't be destructed explicitly.\n", Pike_sp, args);
803e641999-04-02Fredrik Hübinette (Hubbe) #ifdef PIKE_SECURITY if(!CHECK_DATA_SECURITY(o, SECURITY_BIT_DESTRUCT))
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Destruct permission denied.\n");
803e641999-04-02Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  destruct(o);
cb22561995-10-11Fredrik Hübinette (Hubbe)  pop_n_elems(args);
44138c2000-08-02Fredrik Hübinette (Hubbe)  destruct_objects_to_destruct();
5267b71995-08-09Fredrik Hübinette (Hubbe) }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! array indices(string|array|mapping|multiset|object x) *! *! Return an array of all valid indices for the value @[x]. *! *! For strings and arrays this is simply an array of ascending numbers. *! *! For mappings and multisets, the array may contain any value. *! *! For objects which define @[_indices()] that return value will be used. *! *! For other objects an array with all non-static symbols will be returned. *! *! @seealso *! @[values()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_indices(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t size;
cb787a2000-08-24Henrik Grubbström (Grubba)  struct array *a = NULL;
93b7202000-08-14Henrik Grubbström (Grubba) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("indices", 1);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[-args].type)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_STRING:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  size=Pike_sp[-args].u.string->len;
5267b71995-08-09Fredrik Hübinette (Hubbe)  goto qjump; case T_ARRAY:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  size=Pike_sp[-args].u.array->size;
5267b71995-08-09Fredrik Hübinette (Hubbe)  qjump:
99946c1996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(size,0);
5c8e891995-10-29Fredrik Hübinette (Hubbe)  while(--size>=0)
99946c1996-02-17Fredrik Hübinette (Hubbe)  { ITEM(a)[size].type=T_INT; ITEM(a)[size].subtype=NUMBER_NUMBER;
63540d2000-08-15Henrik Grubbström (Grubba)  ITEM(a)[size].u.integer = DO_NOT_WARN((INT_TYPE)size);
99946c1996-02-17Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a=mapping_indices(Pike_sp[-args].u.mapping);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a=copy_array(Pike_sp[-args].u.multiset->ind);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
6d4c4c1995-11-06Fredrik Hübinette (Hubbe)  case T_OBJECT:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a=object_indices(Pike_sp[-args].u.object);
6d4c4c1995-11-06Fredrik Hübinette (Hubbe)  break;
fa31451998-05-25Henrik Grubbström (Grubba)  case T_PROGRAM:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a = program_indices(Pike_sp[-args].u.program);
fa31451998-05-25Henrik Grubbström (Grubba)  break;
0ceb871998-06-07Henrik Grubbström (Grubba)  case T_FUNCTION: {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  struct program *p = program_from_svalue(Pike_sp-args);
0ceb871998-06-07Henrik Grubbström (Grubba)  if (p) { a = program_indices(p); break; } } /* FALL THROUGH */
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("indices", 1, "string|array|mapping|" "multiset|object|program|function");
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; /* make apcc happy */ } pop_n_elems(args); push_array(a); }
4d7b181999-12-07Fredrik Hübinette (Hubbe) /* this should probably be moved to pike_constants.c or something */ #define FIX_OVERLOADED_TYPE(n, lf, X) fix_overloaded_type(n,lf,X,CONSTANT_STRLEN(X)) static node *fix_overloaded_type(node *n, int lfun, const char *deftype, int deftypelen) { node **first_arg; struct pike_string *t,*t2; first_arg=my_get_arg(&_CDR(n), 0); if(!first_arg) return 0; t=first_arg[0]->type; if(!t || match_types(t, object_type_string)) { if(t && t->str[0]==T_OBJECT) { struct program *p=id_to_program(extract_type_int(t->str+2)); if(p) { int fun=FIND_LFUN(p, lfun); /* FIXME: function type string should really be compiled from * the arguments so that or:ed types are handled correctly */
46aa641999-12-29Henrik Grubbström (Grubba)  if(fun!=-1 && (t2=check_call(function_type_string , ID_FROM_INT(p, fun)->type, 0)))
4d7b181999-12-07Fredrik Hübinette (Hubbe)  { free_string(n->type); n->type=t2; return 0; } } } /* If it is an object, it *may* be overloaded, we or with * the deftype.... */ #if 1 if(deftype) { t2=make_shared_binary_string(deftype, deftypelen); t=n->type; n->type=or_pike_types(t,t2,0); free_string(t); free_string(t2); } #endif } return 0; /* continue optimization */ } static node *fix_indices_type(node *n) { return FIX_OVERLOADED_TYPE(n, LFUN__INDICES, tArray); } static node *fix_values_type(node *n) { return FIX_OVERLOADED_TYPE(n, LFUN__VALUES, tArray); }
aab8411999-12-07Henrik Grubbström (Grubba) static node *fix_aggregate_mapping_type(node *n) { struct pike_string *types[2] = { NULL, NULL }; node *args = CDR(n); struct pike_string *new_type = NULL; #ifdef PIKE_DEBUG if (l_flag > 2) { fprintf(stderr, "Fixing type for aggregate_mapping():\n"); print_tree(n); fprintf(stderr, "Original type:"); simple_describe_type(n->type); } #endif /* PIKE_DEBUG */ if (args) { node *arg = args; int argno = 0; /* Make it easier to find... */ args->parent = 0; while(arg) {
f01a891999-12-08Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (l_flag > 4) { fprintf(stderr, "Searching for arg #%d...\n", argno); } #endif /* PIKE_DEBUG */
aab8411999-12-07Henrik Grubbström (Grubba)  if (arg->token == F_ARG_LIST) { if (CAR(arg)) { CAR(arg)->parent = arg; arg = CAR(arg); continue; } if (CDR(arg)) { CDR(arg)->parent = arg; arg = CDR(arg); continue; } /* Retrace */ retrace:
f01a891999-12-08Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (l_flag > 4) { fprintf(stderr, "Retracing in search for arg %d...\n", argno); } #endif /* PIKE_DEBUG */
aab8411999-12-07Henrik Grubbström (Grubba)  while (arg->parent && (!CDR(arg->parent) || (CDR(arg->parent) == arg))) { arg = arg->parent; } if (!arg->parent) { /* No more args. */ break; } arg = arg->parent; CDR(arg)->parent = arg; arg = CDR(arg); continue; } if (arg->token == F_PUSH_ARRAY) { /* FIXME: Should get the type from the pushed array. */ /* FIXME: Should probably be fixed in las.c:fix_type_field() */ MAKE_CONSTANT_SHARED_STRING(new_type, tMap(tMixed, tMixed)); goto set_type; }
f01a891999-12-08Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (l_flag > 4) { fprintf(stderr, "Found arg #%d:\n", argno); print_tree(arg); simple_describe_type(arg->type);
aab8411999-12-07Henrik Grubbström (Grubba)  }
f01a891999-12-08Henrik Grubbström (Grubba) #endif /* PIKE_DEBUG */ do { if (types[argno]) { struct pike_string *t = or_pike_types(types[argno], arg->type, 0); free_string(types[argno]); types[argno] = t; #ifdef PIKE_DEBUG if (l_flag > 4) { fprintf(stderr, "Resulting type for arg #%d:\n", argno); simple_describe_type(types[argno]); } #endif /* PIKE_DEBUG */ } else { copy_shared_string(types[argno], arg->type); } argno = !argno; /* Handle the special case where CAR & CDR are the same. * Only occurrs with SHARED_NODES. */ } while (argno && arg->parent && CAR(arg->parent) == CDR(arg->parent));
aab8411999-12-07Henrik Grubbström (Grubba)  goto retrace; } if (argno) { yyerror("Odd number of arguments to aggregate_mapping()."); goto done; } if (!types[0]) { MAKE_CONSTANT_SHARED_STRING(new_type, tMap(tZero, tZero)); goto set_type; } type_stack_mark(); push_unfinished_type(types[1]->str); push_unfinished_type(types[0]->str); push_type(T_MAPPING); new_type = pop_unfinished_type(); } else { MAKE_CONSTANT_SHARED_STRING(new_type, tMap(tZero, tZero)); goto set_type; } if (new_type) { set_type: free_string(n->type); n->type = new_type; #ifdef PIKE_DEBUG if (l_flag > 2) { fprintf(stderr, "Result type: "); simple_describe_type(new_type); } #endif /* PIKE_DEBUG */ if (n->parent) { n->parent->node_info |= OPT_TYPE_NOT_FIXED; } } done: if (args) { /* Not really needed, but... */ args->parent = n; } if (types[1]) { free_string(types[1]); } if (types[0]) { free_string(types[0]); } return NULL; }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! array values(string|array|mapping|multiset|object x) *! *! Return an array of all possible values from indexing the value @[x]. *! *! For strings an array of int with the ISO10646 codes of the characters in *! the string is returned. *! *! For a multiset an array filled with ones (@tt{1@}) is returned. *! *! For arrays a single-level copy of @[x] is returned. *! *! For mappings the array may contain any value. *! *! For objects which define @[_values()] that return value will be used. *! *! For other objects an array with the values of all non-static symbols *! will be returned. *! *! @seealso *! @[indices()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_values(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t size;
cb787a2000-08-24Henrik Grubbström (Grubba)  struct array *a = NULL;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("values", 1);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[-args].type)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_STRING:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  size = Pike_sp[-args].u.string->len;
c628dc1998-10-10Henrik Grubbström (Grubba)  a = allocate_array_no_init(size,0); while(--size >= 0)
99946c1996-02-17Fredrik Hübinette (Hubbe)  {
c628dc1998-10-10Henrik Grubbström (Grubba)  ITEM(a)[size].type = T_INT; ITEM(a)[size].subtype = NUMBER_NUMBER;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ITEM(a)[size].u.integer = index_shared_string(Pike_sp[-args].u.string, size);
99946c1996-02-17Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_ARRAY:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a=copy_array(Pike_sp[-args].u.array);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a=mapping_values(Pike_sp[-args].u.mapping);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  size=Pike_sp[-args].u.multiset->ind->size;
99946c1996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(size,0); while(--size>=0) { ITEM(a)[size].type=T_INT; ITEM(a)[size].subtype=NUMBER_NUMBER; ITEM(a)[size].u.integer=1; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
6d4c4c1995-11-06Fredrik Hübinette (Hubbe)  case T_OBJECT:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a=object_values(Pike_sp[-args].u.object);
6d4c4c1995-11-06Fredrik Hübinette (Hubbe)  break;
fa31451998-05-25Henrik Grubbström (Grubba)  case T_PROGRAM:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a = program_values(Pike_sp[-args].u.program);
fa31451998-05-25Henrik Grubbström (Grubba)  break;
0ceb871998-06-07Henrik Grubbström (Grubba)  case T_FUNCTION: {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  struct program *p = program_from_svalue(Pike_sp - args);
0ceb871998-06-07Henrik Grubbström (Grubba)  if (p) { a = program_values(p); break; } } /* FALL THROUGH */
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("values", 1, "string|array|mapping|multiset|" "object|program|function");
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; /* make apcc happy */ } pop_n_elems(args); push_array(a); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl object next_object(object o) *! @decl object next_object() *! *! Returns the next object from the list of all objects. *! *! All objects are stored in a linked list. *! *! If no arguments have been given @[next_object()] will return the first *! object from the list. *! *! If @[o] has been specified the object after @[o] on the list will be *! returned. *! *! @note *! This function is not recomended to use. *! *! @seealso *! @[destruct()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_next_object(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct object *o; if(args < 1) {
87a6082000-09-30Henrik Grubbström (Grubba)  o = first_object;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_OBJECT)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("next_object", 1, "object");
87a6082000-09-30Henrik Grubbström (Grubba)  o = Pike_sp[-args].u.object->next;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
87a6082000-09-30Henrik Grubbström (Grubba)  while(o && !o->prog) o=o->next;
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); if(!o) { push_int(0); }else{
0e88611998-04-16Fredrik Hübinette (Hubbe)  ref_push_object(o);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl program object_program(mixed o) *! *! Return the program from which @[o] was instantiated. *! *! If @[o] is not an object or has been destructed @tt{0@} (zero) *! will be returned. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_object_program(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("object_program", 1);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type == T_OBJECT)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  struct object *o=Pike_sp[-args].u.object;
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  struct program *p; if((p=o->prog)) { if(o->parent && o->parent->prog) { INT32 id=o->parent_identifier; o=o->parent;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(o);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_object(o);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp[-1].subtype=id; Pike_sp[-1].type=T_FUNCTION;
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  return; }else{
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(p);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_program(p); return; } }
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(0);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
70c9261999-12-22Henrik Grubbström (Grubba) node *fix_object_program_type(node *n) { /* Fix the type for a common case: * * object_program(object(is|implements foo)) */ node *nn; struct pike_string *new_type = NULL; if (!n->type) { copy_shared_string(n->type, program_type_string); } if (!(nn = CDR(n))) return NULL; if ((nn->token == F_ARG_LIST) && (!(nn = CAR(nn)))) return NULL; if (!nn->type) return NULL; /* Perform the actual conversion. */ new_type = object_type_to_program_type(nn->type); if (new_type) { free_string(n->type); n->type = new_type; } return NULL; }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl string reverse(string s) *! @decl array reverse(array a) *! @decl int reverse(int i) *! *! Reverses a string, array or int. *! *! This function reverses a string, char by char, an array, value *! by value or an int, bit by bit and returns the result. *! *! Reversing strings can be particularly useful for parsing difficult *! syntaxes which require scanning backwards. *! *! @seealso *! @[sscanf()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_reverse(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("reverse", 1);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[-args].type)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_STRING: { INT32 e;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  s=begin_wide_shared_string(Pike_sp[-args].u.string->len, Pike_sp[-args].u.string->size_shift); switch(Pike_sp[-args].u.string->size_shift)
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  { case 0:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  for(e=0;e<Pike_sp[-args].u.string->len;e++) STR0(s)[e]=STR0(Pike_sp[-args].u.string)[Pike_sp[-args].u.string->len-1-e];
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break; case 1:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  for(e=0;e<Pike_sp[-args].u.string->len;e++) STR1(s)[e]=STR1(Pike_sp[-args].u.string)[Pike_sp[-args].u.string->len-1-e];
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break; case 2:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  for(e=0;e<Pike_sp[-args].u.string->len;e++) STR2(s)[e]=STR2(Pike_sp[-args].u.string)[Pike_sp[-args].u.string->len-1-e];
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break; } s=low_end_shared_string(s);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(s); break; } case T_INT: { INT32 e;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  e=Pike_sp[-args].u.integer;
5c8e891995-10-29Fredrik Hübinette (Hubbe)  e=((e & 0x55555555UL)<<1) + ((e & 0xaaaaaaaaUL)>>1); e=((e & 0x33333333UL)<<2) + ((e & 0xccccccccUL)>>2); e=((e & 0x0f0f0f0fUL)<<4) + ((e & 0xf0f0f0f0UL)>>4); e=((e & 0x00ff00ffUL)<<8) + ((e & 0xff00ff00UL)>>8); e=((e & 0x0000ffffUL)<<16)+ ((e & 0xffff0000UL)>>16);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp[-args].u.integer=e;
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); break; } case T_ARRAY: { struct array *a;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a=reverse_array(Pike_sp[-args].u.array);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_array(a); break; } default:
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("reverse", 1, "string|int|array");
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } struct tupel {
7e97c31999-01-21Fredrik Hübinette (Hubbe)  int prefix; struct pike_string *ind; struct pike_string *val;
5267b71995-08-09Fredrik Hübinette (Hubbe) };
7e97c31999-01-21Fredrik Hübinette (Hubbe) static int replace_sortfun(struct tupel *a,struct tupel *b)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
93b7202000-08-14Henrik Grubbström (Grubba)  return DO_NOT_WARN((int)my_quick_strcmp(a->ind, b->ind));
5267b71995-08-09Fredrik Hübinette (Hubbe) }
7e97c31999-01-21Fredrik Hübinette (Hubbe) /* Magic, magic and more magic */ static int find_longest_prefix(char *str,
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t len,
7e97c31999-01-21Fredrik Hübinette (Hubbe)  int size_shift, struct tupel *v, INT32 a, INT32 b) {
93b7202000-08-14Henrik Grubbström (Grubba)  INT32 c,match=-1; ptrdiff_t tmp;
7e97c31999-01-21Fredrik Hübinette (Hubbe)  while(a<b) { c=(a+b)/2; tmp=generic_quick_binary_strcmp(v[c].ind->str, v[c].ind->len, v[c].ind->size_shift, str, MINIMUM(len,v[c].ind->len), size_shift); if(tmp<0) { INT32 match2=find_longest_prefix(str, len, size_shift, v, c+1, b); if(match2!=-1) return match2; while(1) { if(v[c].prefix==-2) { v[c].prefix=find_longest_prefix(v[c].ind->str, v[c].ind->len, v[c].ind->size_shift, v, 0 /* can this be optimized? */, c); } c=v[c].prefix; if(c<a || c<match) return match; if(!generic_quick_binary_strcmp(v[c].ind->str, v[c].ind->len, v[c].ind->size_shift, str, MINIMUM(len,v[c].ind->len), size_shift)) return c; } } else if(tmp>0) { b=c; } else { a=c+1; /* There might still be a better match... */ match=c; } } return match; }
06983f1996-09-22Fredrik Hübinette (Hubbe) static struct pike_string * replace_many(struct pike_string *str,
3beb891996-06-21Fredrik Hübinette (Hubbe)  struct array *from, struct array *to)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
93b7202000-08-14Henrik Grubbström (Grubba)  INT32 e,num; ptrdiff_t s, length;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  struct string_builder ret;
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct tupel *v; int set_start[256]; int set_end[256]; if(from->size != to->size)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Replace must have equal-sized from and to arrays.\n");
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!from->size) { reference_shared_string(str); return str; } v=(struct tupel *)xalloc(sizeof(struct tupel)*from->size);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(num=e=0;e<from->size;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
99946c1996-02-17Fredrik Hübinette (Hubbe)  if(ITEM(from)[e].type != T_STRING)
3e625c1998-10-11Fredrik Hübinette (Hubbe)  { free((char *)v);
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Replace: from array is not array(string)\n");
3e625c1998-10-11Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
99946c1996-02-17Fredrik Hübinette (Hubbe)  if(ITEM(to)[e].type != T_STRING)
3e625c1998-10-11Fredrik Hübinette (Hubbe)  { free((char *)v);
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Replace: to array is not array(string)\n");
3e625c1998-10-11Fredrik Hübinette (Hubbe)  } if(ITEM(from)[e].u.string->size_shift > str->size_shift) continue; v[num].ind=ITEM(from)[e].u.string; v[num].val=ITEM(to)[e].u.string;
7e97c31999-01-21Fredrik Hübinette (Hubbe)  v[num].prefix=-2; /* Uninitialized */
3e625c1998-10-11Fredrik Hübinette (Hubbe)  num++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  fsort((char *)v,num,sizeof(struct tupel),(fsortfun)replace_sortfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(e=0;e<(INT32)NELEM(set_end);e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  set_end[e]=set_start[e]=0;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(e=0;e<num;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
3e625c1998-10-11Fredrik Hübinette (Hubbe)  INT32 x; x=index_shared_string(v[num-1-e].ind,0); if(x<(INT32)NELEM(set_start)) set_start[x]=num-e-1; x=index_shared_string(v[e].ind,0); if(x<(INT32)NELEM(set_end)) set_end[x]=e+1;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  init_string_builder(&ret,str->size_shift);
5267b71995-08-09Fredrik Hübinette (Hubbe)  length=str->len;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(s=0;length > 0;)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
93b7202000-08-14Henrik Grubbström (Grubba)  INT32 a,b; ptrdiff_t ch;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  ch=index_shared_string(str,s);
93b7202000-08-14Henrik Grubbström (Grubba)  if(ch<(ptrdiff_t)NELEM(set_end)) b=set_end[ch]; else b=num;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  if(b)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
93b7202000-08-14Henrik Grubbström (Grubba)  if(ch<(ptrdiff_t)NELEM(set_start)) a=set_start[ch]; else a=0;
3e625c1998-10-11Fredrik Hübinette (Hubbe) 
7e97c31999-01-21Fredrik Hübinette (Hubbe)  a=find_longest_prefix(str->str+(s << str->size_shift), length, str->size_shift, v, a, b); if(a!=-1)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
93b7202000-08-14Henrik Grubbström (Grubba)  ch = v[a].ind->len;
7e97c31999-01-21Fredrik Hübinette (Hubbe)  if(!ch) ch=1; s+=ch; length-=ch;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  string_builder_shared_strcat(&ret,v[a].val);
5267b71995-08-09Fredrik Hübinette (Hubbe)  continue; } }
93b7202000-08-14Henrik Grubbström (Grubba)  string_builder_putchar(&ret, DO_NOT_WARN((INT32)ch));
5267b71995-08-09Fredrik Hübinette (Hubbe)  s++; length--; } free((char *)v);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  return finish_string_builder(&ret);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl string replace(string s, string from, string to) *! @decl string replace(string s, array(string) from, array(string) to) *! @decl array replace(array a, mixed from, mixed to) *! @decl mapping replace(mapping a, mixed from, mixed to) *! *! Generic replace function. *! *! This function can do several kinds replacement operations, the *! different syntaxes do different things as follows: *! *! If all the arguments are strings, a copy of @[s] with every occurrence *! of @[from] replaced with @[to] will be returned. *! *! If the first argument is a string, and the others array(string), a string *! with every occurrance of @[from][@i{i@}] in @[s] replaced with *! @[to][@i{i@}] will be returned. *! *! If the first argument is an array or mapping, the values of @[a] which *! are @[`==()] with @[from] will be replaced with @[to] destructively. *! @[a] will then be returned. *! *! @note *! Note that @[replace()] on arrays and mappings is a destructive operation. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_replace(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { if(args < 3)
f7a4462000-10-31Mirar (Pontus Hagland)  { if (args==2 && Pike_sp[1-args].type==T_MAPPING) { stack_dup(); f_indices(1); stack_swap(); f_values(1); args++; } else SIMPLE_TOO_FEW_ARGS_ERROR("replace", 3); }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[-args].type)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_ARRAY: {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  array_replace(Pike_sp[-args].u.array,Pike_sp+1-args,Pike_sp+2-args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); break; } case T_MAPPING: {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mapping_replace(Pike_sp[-args].u.mapping,Pike_sp+1-args,Pike_sp+2-args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); break; } case T_STRING: {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[1-args].type)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { default:
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("replace", 2, "string|array");
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_STRING:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[2-args].type != T_STRING)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("replace", 3, "string");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  s=string_replace(Pike_sp[-args].u.string, Pike_sp[1-args].u.string, Pike_sp[2-args].u.string);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_ARRAY:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[2-args].type != T_ARRAY)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("replace", 3, "array");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  s=replace_many(Pike_sp[-args].u.string, Pike_sp[1-args].u.array, Pike_sp[2-args].u.array);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } pop_n_elems(args); push_string(s); break; }
8b63781996-04-11Fredrik Hübinette (Hubbe)  default:
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("replace", 1, "array|mapping|string");
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl program compile(string source, object|void handler, *! int|void major, int|void minor) *! *! Compile a string to a program. *! *! This function takes a piece of Pike code as a string and *! compiles it into a clonable program. *! *! The optional argument @[handler] is used to specify an alternative *! error handler. If it is not specified the current master object will *! be used. *! *! The optional arguments @[major] and @[minor] are used to tell the compiler *! to attempt to be compatible with Pike @[major].@[minor]. *! *! @note *! Note that @[source] must contain the complete source for a program. *! It is not possible to compile a single expression or statement. *! *! Also note that @[compile()] does not preprocess the program. *! To preprocess the program you can use @[compile_string()] or *! call the preprocessor manually by calling @[cpp()]. *! *! @seealso *! @[compile_string()], @[compile_file()], @[cpp()], @[master()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_compile(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct program *p;
ac87152000-09-25Fredrik Hübinette (Hubbe)  struct object *o; int major=-1; int minor=-1;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe) 
ac87152000-09-25Fredrik Hübinette (Hubbe)  check_all_args("compile",args, BIT_STRING, BIT_VOID | BIT_INT | BIT_OBJECT, BIT_VOID | BIT_INT, BIT_VOID | BIT_INT, 0);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) 
ac87152000-09-25Fredrik Hübinette (Hubbe)  o=0; if (args > 1) if(Pike_sp[1-args].type == T_OBJECT) o=Pike_sp[1-args].u.object;
42a92c1999-11-04Henrik Grubbström (Grubba) 
ac87152000-09-25Fredrik Hübinette (Hubbe)  if(args == 3) SIMPLE_BAD_ARG_ERROR("compile", 4, "int"); if(args > 3) { major=sp[2-args].u.integer; minor=sp[3-args].u.integer;
42a92c1999-11-04Henrik Grubbström (Grubba)  }
ac87152000-09-25Fredrik Hübinette (Hubbe)  p = compile(Pike_sp[-args].u.string, o, major, minor);
1aceca1999-12-27Martin Stjernholm #ifdef PIKE_DEBUG if(!(p->flags & PROGRAM_FINISHED)) fatal("Got unfinished program from internal compile().\n"); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_program(p); }
ed1cc32001-01-09Henrik Grubbström (Grubba)  /*! @decl array|mapping|multiset set_weak_flag(array|mapping|multiset m, *! int(0..1) state) *! *! Set the value @[m] to hold weak references if @[state] is @tt{1@}. *! Reset to strong references otherwise. *! *! @returns *! @[m] will be returned. */
5f06241999-04-11Fredrik Hübinette (Hubbe) #define SETFLAG(FLAGS,FLAG,ONOFF) \ FLAGS = (FLAGS & ~FLAG) | ( ONOFF ? FLAG : 0 )
3b589f1999-02-04Fredrik Hübinette (Hubbe) void f_set_weak_flag(INT32 args) {
5f06241999-04-11Fredrik Hübinette (Hubbe)  struct svalue *s;
5665ab1999-07-28Henrik Grubbström (Grubba)  INT_TYPE ret;
5f06241999-04-11Fredrik Hübinette (Hubbe)  get_all_args("set_weak_flag",args,"%*%i",&s,&ret); switch(s->type)
3b589f1999-02-04Fredrik Hübinette (Hubbe)  {
5f06241999-04-11Fredrik Hübinette (Hubbe)  case T_ARRAY: SETFLAG(s->u.array->flags,ARRAY_WEAK_FLAG,ret); break;
880be62000-09-04Martin Stjernholm  case T_MAPPING: { int flags = mapping_get_flags(s->u.mapping); SETFLAG(flags,MAPPING_FLAG_WEAK,ret); mapping_set_flags(s->u.mapping, flags);
5f06241999-04-11Fredrik Hübinette (Hubbe)  break;
880be62000-09-04Martin Stjernholm  }
e99c7a1999-10-29Martin Stjernholm  case T_MULTISET: SETFLAG(s->u.multiset->ind->flags,(ARRAY_WEAK_FLAG|ARRAY_WEAK_SHRINK),ret); break;
5f06241999-04-11Fredrik Hübinette (Hubbe)  default:
e99c7a1999-10-29Martin Stjernholm  SIMPLE_BAD_ARG_ERROR("set_weak_flag",1,"array|mapping|multiset");
3b589f1999-02-04Fredrik Hübinette (Hubbe)  }
5f06241999-04-11Fredrik Hübinette (Hubbe)  pop_n_elems(args-1);
3b589f1999-02-04Fredrik Hübinette (Hubbe) }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl int objectp(mixed arg) *! *! Returns @tt{1@} if @[arg] is an object, @tt{0@} (zero) otherwise. *! *! @seealso *! @[mappingp()], @[programp()], @[arrayp()], @[stringp()], @[functionp()], *! @[multisetp()], @[floatp()], @[intp()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_objectp(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(args<1) SIMPLE_TOO_FEW_ARGS_ERROR("objectp", 1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_OBJECT || !Pike_sp[-args].u.object->prog
3905cf1999-11-11Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM
edf4d02000-07-06Fredrik Hübinette (Hubbe)  || is_bignum_object(Pike_sp[-args].u.object)
3905cf1999-11-11Fredrik Hübinette (Hubbe) #endif )
5267b71995-08-09Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0); }else{ pop_n_elems(args); push_int(1); } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int functionp(mixed arg) *! *! Returns @tt{1@} if @[arg] is a function, @tt{0@} (zero) otherwise. *! *! @seealso *! @[mappingp()], @[programp()], @[arrayp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[intp()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_functionp(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(args<1) SIMPLE_TOO_FEW_ARGS_ERROR("functionp", 1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_FUNCTION || (Pike_sp[-args].subtype != FUNCTION_BUILTIN && !Pike_sp[-args].u.object->prog))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0); }else{ pop_n_elems(args); push_int(1); } }
89b0721998-05-05Fredrik Hübinette (Hubbe) #ifndef HAVE_AND_USE_POLL #undef HAVE_POLL #endif
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl void sleep(int|float s) *! *! This function makes the program stop for @[s] seconds. *! *! Only signal handlers can interrupt the sleep. Other callbacks are *! not called during sleep. *! *! @seealso *! @[signal()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_sleep(INT32 args)
cb22561995-10-11Fredrik Hübinette (Hubbe) {
8380171999-12-06Mirar (Pontus Hagland) #define POLL_SLEEP_LIMIT 0.02
cb22561995-10-11Fredrik Hübinette (Hubbe) 
8380171999-12-06Mirar (Pontus Hagland) #ifdef HAVE_GETHRTIME hrtime_t t0,tv; #else struct timeval t0,tv; #endif
3beb891996-06-21Fredrik Hübinette (Hubbe) 
8380171999-12-06Mirar (Pontus Hagland)  double delay=0.0; double target; int do_microsleep;
3beb891996-06-21Fredrik Hübinette (Hubbe) 
8380171999-12-06Mirar (Pontus Hagland) #ifdef HAVE_GETHRTIME t0=tv=gethrtime(); #define GET_TIME_ELAPSED tv=gethrtime() #define TIME_ELAPSED (tv-t0)*1e-9 #else GETTIMEOFDAY(&t0); tv=t0; #define GET_TIME_ELAPSED GETTIMEOFDAY(&tv) #define TIME_ELAPSED ((tv.tv_sec-t0.tv_sec) + (tv.tv_usec-t0.tv_usec)*1e-6)
dac6371999-10-17Mirar (Pontus Hagland) #endif
3beb891996-06-21Fredrik Hübinette (Hubbe) 
0dbb5c2000-02-22Fredrik Hübinette (Hubbe) #define FIX_LEFT() \ GET_TIME_ELAPSED; \ left = delay - TIME_ELAPSED; \ if (do_microsleep) left-=POLL_SLEEP_LIMIT;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[-args].type)
8380171999-12-06Mirar (Pontus Hagland)  { case T_INT:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  delay=(double)Pike_sp[-args].u.integer;
8380171999-12-06Mirar (Pontus Hagland)  break;
b48f281998-03-26Henrik Grubbström (Grubba) 
8380171999-12-06Mirar (Pontus Hagland)  case T_FLOAT:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  delay=(double)Pike_sp[-args].u.float_number;
8380171999-12-06Mirar (Pontus Hagland)  break; }
cb22561995-10-11Fredrik Hübinette (Hubbe) 
0dbb5c2000-02-22Fredrik Hübinette (Hubbe)  /* Special case, sleep(0) means 'yield' */ if(delay == 0.0) { check_threads_etc(); pop_n_elems(args); return; }
8380171999-12-06Mirar (Pontus Hagland)  do_microsleep=delay<10; pop_n_elems(args);
c4a8b11999-12-09Henrik Grubbström (Grubba) 
8380171999-12-06Mirar (Pontus Hagland)  if (delay>POLL_SLEEP_LIMIT)
2ad6b72000-01-29Mirar (Pontus Hagland)  {
0dbb5c2000-02-22Fredrik Hübinette (Hubbe)  while(1) { double left; /* THREADS_ALLOW may take longer time then POLL_SLEEP_LIMIT */ THREADS_ALLOW();
865dc22000-04-13Henrik Grubbström (Grubba)  do { FIX_LEFT(); if(left<=0.0) break;
0dbb5c2000-02-22Fredrik Hübinette (Hubbe) 
89b0721998-05-05Fredrik Hübinette (Hubbe) #ifdef __NT__
93b7202000-08-14Henrik Grubbström (Grubba)  Sleep(DO_NOT_WARN((int)(left*1000)));
89b0721998-05-05Fredrik Hübinette (Hubbe) #elif defined(HAVE_POLL)
865dc22000-04-13Henrik Grubbström (Grubba)  poll(NULL,0,(int)(left*1000));
89b0721998-05-05Fredrik Hübinette (Hubbe) #else
865dc22000-04-13Henrik Grubbström (Grubba)  { struct timeval t3; t3.tv_sec=left; t3.tv_usec=(int)((left - (int)left)*1e6); select(0,0,0,0,&t3); }
89b0721998-05-05Fredrik Hübinette (Hubbe) #endif
865dc22000-04-13Henrik Grubbström (Grubba)  } while(0);
0dbb5c2000-02-22Fredrik Hübinette (Hubbe)  THREADS_DISALLOW(); FIX_LEFT(); if(left<=0.0) { break; }else{ check_signals(0,0,0); } }
2ad6b72000-01-29Mirar (Pontus Hagland)  }
8380171999-12-06Mirar (Pontus Hagland)  if (do_microsleep) while (delay>TIME_ELAPSED) GET_TIME_ELAPSED;
cb22561995-10-11Fredrik Hübinette (Hubbe) }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! int gc() *! *! Force garbage collection. *! *! This function checks all the memory for cyclic structures such *! as arrays containing themselves and frees them if appropriate. *! It also frees up destructed objects. It then returns how many *! arrays/objects/programs/etc. it managed to free by doing this. *! *! Normally there is no need to call this function since Pike will *! call it by itself every now and then. (Pike will try to predict *! when 20% of all arrays/object/programs in memory is 'garbage' *! and call this routine then.) */
624d091996-02-24Fredrik Hübinette (Hubbe) void f_gc(INT32 args) { INT32 tmp; pop_n_elems(args);
bbc8b92000-06-10Martin Stjernholm  push_int(do_gc());
624d091996-02-24Fredrik Hübinette (Hubbe) }
5267b71995-08-09Fredrik Hübinette (Hubbe) #ifdef TYPEP #undef TYPEP #endif
10f5031999-10-21Fredrik Noring #ifdef AUTO_BIGNUM
bbc8b92000-06-10Martin Stjernholm /* This should probably be here whether AUTO_BIGNUM is defined or not,
aa73fc1999-10-21Fredrik Hübinette (Hubbe)  * but it can wait a little. /Hubbe */ #define TYPEP(ID,NAME,TYPE,TYPE_NAME) \
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void ID(INT32 args) \
aa73fc1999-10-21Fredrik Hübinette (Hubbe) { \ int t; \ if(args<1) \ SIMPLE_TOO_FEW_ARGS_ERROR(NAME, 1); \
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type == T_OBJECT && Pike_sp[-args].u.object->prog) \
aa73fc1999-10-21Fredrik Hübinette (Hubbe)  { \
edf4d02000-07-06Fredrik Hübinette (Hubbe)  int fun=FIND_LFUN(Pike_sp[-args].u.object->prog,LFUN__IS_TYPE); \
aa73fc1999-10-21Fredrik Hübinette (Hubbe)  if(fun != -1) \ { \ push_constant_text(TYPE_NAME); \
edf4d02000-07-06Fredrik Hübinette (Hubbe)  apply_low(Pike_sp[-args-1].u.object,fun,1); \
aa73fc1999-10-21Fredrik Hübinette (Hubbe)  stack_unlink(args); \ return; \ } \ } \
edf4d02000-07-06Fredrik Hübinette (Hubbe)  t=Pike_sp[-args].type == TYPE; \
aa73fc1999-10-21Fredrik Hübinette (Hubbe)  pop_n_elems(args); \ push_int(t); \
10f5031999-10-21Fredrik Noring } #else
5267b71995-08-09Fredrik Hübinette (Hubbe) #define TYPEP(ID,NAME,TYPE) \ void ID(INT32 args) \ { \ int t; \
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(args<1) SIMPLE_TOO_FEW_ARGS_ERROR(NAME, 1); \
edf4d02000-07-06Fredrik Hübinette (Hubbe)  t=Pike_sp[-args].type == TYPE; \
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); \ push_int(t); \ }
10f5031999-10-21Fredrik Noring #endif /* AUTO_BIGNUM */
b1f4eb1998-01-13Fredrik Hübinette (Hubbe) 
3b0f9f1999-10-22Henrik Grubbström (Grubba) 
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int programp(mixed arg) *! *! Returns @tt{1@} if @[arg] is a program, @tt{0@} (zero) otherwise. *! *! @seealso *! @[mappingp()], @[intp()], @[arrayp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[functionp()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_programp(INT32 args)
b1f4eb1998-01-13Fredrik Hübinette (Hubbe) { if(args<1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("programp", 1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[-args].type)
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  { case T_PROGRAM: pop_n_elems(args); push_int(1); return; case T_FUNCTION:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(program_from_function(Pike_sp-args))
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(1); return; } default: pop_n_elems(args); push_int(0); } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int intp(mixed arg) *! *! Returns @tt{1@} if @[arg] is an int, @tt{0@} (zero) otherwise. *! *! @seealso *! @[mappingp()], @[programp()], @[arrayp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[functionp()] */ /*! @decl int mappingp(mixed arg) *! *! Returns @tt{1@} if @[arg] is a mapping, @tt{0@} (zero) otherwise. *! *! @seealso *! @[intp()], @[programp()], @[arrayp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[functionp()] */ /*! @decl int arrayp(mixed arg) *! *! Returns @tt{1@} if @[arg] is an array, @tt{0@} (zero) otherwise. *! *! @seealso *! @[intp()], @[programp()], @[mappingp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[functionp()] */ /*! @decl int multisetp(mixed arg) *! *! Returns @tt{1@} if @[arg] is a multiset, @tt{0@} (zero) otherwise. *! *! @seealso *! @[intp()], @[programp()], @[arrayp()], @[stringp()], @[objectp()], *! @[mappingp()], @[floatp()], @[functionp()] */ /*! @decl int stringp(mixed arg) *! *! Returns @tt{1@} if @[arg] is a string, @tt{0@} (zero) otherwise. *! *! @seealso *! @[intp()], @[programp()], @[arrayp()], @[multisetp()], @[objectp()], *! @[mappingp()], @[floatp()], @[functionp()] */ /*! @decl int floatp(mixed arg) *! *! Returns @tt{1@} if @[arg] is a float, @tt{0@} (zero) otherwise. *! *! @seealso *! @[intp()], @[programp()], @[arrayp()], @[multisetp()], @[objectp()], *! @[mappingp()], @[stringp()], @[functionp()] */
39ac731999-10-20Fredrik Noring #ifdef AUTO_BIGNUM
10f5031999-10-21Fredrik Noring TYPEP(f_intp, "intp", T_INT, "int") TYPEP(f_mappingp, "mappingp", T_MAPPING, "mapping") TYPEP(f_arrayp, "arrayp", T_ARRAY, "array") TYPEP(f_multisetp, "multisetp", T_MULTISET, "multiset") TYPEP(f_stringp, "stringp", T_STRING, "string") TYPEP(f_floatp, "floatp", T_FLOAT, "float")
39ac731999-10-20Fredrik Noring #else TYPEP(f_intp, "intp", T_INT)
5267b71995-08-09Fredrik Hübinette (Hubbe) TYPEP(f_mappingp, "mappingp", T_MAPPING) TYPEP(f_arrayp, "arrayp", T_ARRAY)
06983f1996-09-22Fredrik Hübinette (Hubbe) TYPEP(f_multisetp, "multisetp", T_MULTISET)
5267b71995-08-09Fredrik Hübinette (Hubbe) TYPEP(f_stringp, "stringp", T_STRING) TYPEP(f_floatp, "floatp", T_FLOAT)
10f5031999-10-21Fredrik Noring #endif /* AUTO_BIGNUM */
ed1cc32001-01-09Henrik Grubbström (Grubba)  /*! @decl array sort(array(mixed) index, array(mixed) ... data) *! *! Sort arrays destructively. *! *! This function sorts the array @[index] destructively. That means *! that the array itself is changed and returned, no copy is created. *! *! If extra arguments are given, they are supposed to be arrays of the *! same size as @[index]. Each of these arrays will be modified in the *! same way as @[index]. I.e. if index 3 is moved to position 0 in @[index] *! index 3 will be moved to position 0 in all the other arrays as well. *! *! @[sort()] can sort strings, integers and floats in ascending order. *! Arrays will be sorted first on the first element of each array. *! Objects will be sorted in ascending order according to @[`<()], @[`>()] *! and @[`==()]. *! *! @returns *! The first argument will be returned. *! *! @note *! The sorting algorithm used is not stable, ie elements that are equal *! may get reordered. *! *! @seealso *! @[reverse()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_sort(INT32 args)
ed70b71996-06-09Fredrik Hübinette (Hubbe) { INT32 e,*order;
bee4301997-02-24Fredrik Hübinette (Hubbe)  if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("sort", 1);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  for(e=0;e<args;e++) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[e-args].type != T_ARRAY)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("sort", e+1, "array");
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[e-args].u.array->size != Pike_sp[-args].u.array->size) bad_arg_error("sort", Pike_sp-args, args, e+1, "array", Pike_sp+e-args,
d0d01b1999-03-20Henrik Grubbström (Grubba)  "Argument %d has wrong size.\n", (e+1));
ed70b71996-06-09Fredrik Hübinette (Hubbe)  }
3beb891996-06-21Fredrik Hübinette (Hubbe)  if(args > 1) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  order=get_alpha_order(Pike_sp[-args].u.array); for(e=0;e<args;e++) order_array(Pike_sp[e-args].u.array,order);
3beb891996-06-21Fredrik Hübinette (Hubbe)  free((char *)order); pop_n_elems(args-1); } else {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  sort_array_destructively(Pike_sp[-args].u.array);
3beb891996-06-21Fredrik Hübinette (Hubbe)  }
ed70b71996-06-09Fredrik Hübinette (Hubbe) }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl array rows(mixed data, array index) *! *! Select a set of rows from an array. *! *! This function is en optimized equivalent to: *! *! @code{map(@[index], lambda(mixed x) { return @[data][x]; })@} *! *! That is, it indices data on every index in the array index and *! returns an array with the results. *! *! @seealso *! @[column()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_rows(INT32 args)
ed70b71996-06-09Fredrik Hübinette (Hubbe) { INT32 e; struct array *a,*tmp;
d0d01b1999-03-20Henrik Grubbström (Grubba)  struct svalue *val;
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  get_all_args("rows", args, "%*%a", &val, &tmp);
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
8669721999-08-02Fredrik Hübinette (Hubbe)  /* Optimization */ if(tmp->refs == 1) { struct svalue sval; tmp->type_field = BIT_MIXED | BIT_UNFINISHED; for(e=0;e<tmp->size;e++) { index_no_free(&sval, val, ITEM(tmp)+e); free_svalue(ITEM(tmp)+e); ITEM(tmp)[e]=sval; } stack_swap(); pop_stack(); return; }
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
8669721999-08-02Fredrik Hübinette (Hubbe)  push_array(a=allocate_array(tmp->size));
ed70b71996-06-09Fredrik Hübinette (Hubbe)  for(e=0;e<a->size;e++)
d0d01b1999-03-20Henrik Grubbström (Grubba)  index_no_free(ITEM(a)+e, val, ITEM(tmp)+e);
8669721999-08-02Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; dmalloc_touch_svalue(Pike_sp);
d0d01b1999-03-20Henrik Grubbström (Grubba)  pop_n_elems(args);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  push_array(a); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl void _verify_internals() *! *! Perform sanity checks. *! *! This function goes through most of the internal Pike structures and *! generates a fatal error if one of them is found to be out of order. *! It is only used for debugging. *! *! @note *! This function is only available if the Pike runtime has been compiled *! with RTL debug. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__verify_internals(INT32 args)
ed70b71996-06-09Fredrik Hübinette (Hubbe) {
05590d1998-04-23Fredrik Hübinette (Hubbe)  INT32 tmp=d_flag;
d0d01b1999-03-20Henrik Grubbström (Grubba)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_verify_internals: permission denied.\n"));
ed70b71996-06-09Fredrik Hübinette (Hubbe)  d_flag=0x7fffffff; do_debug(); d_flag=tmp;
0381531996-09-25Fredrik Hübinette (Hubbe)  do_gc();
ed70b71996-06-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl int _debug(int(0..) level) *! *! Set the run-time debug level. *! *! @returns *! The old debug level will be returned. *! *! @note *! This function is only available if the Pike runtime has been compiled *! with RTL debug. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__debug(INT32 args)
a03d951997-10-14Fredrik Hübinette (Hubbe) {
5665ab1999-07-28Henrik Grubbström (Grubba)  INT_TYPE d;
d0d01b1999-03-20Henrik Grubbström (Grubba)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_debug: permission denied.\n"));
5665ab1999-07-28Henrik Grubbström (Grubba)  get_all_args("_debug", args, "%i", &d);
a03d951997-10-14Fredrik Hübinette (Hubbe)  pop_n_elems(args);
5665ab1999-07-28Henrik Grubbström (Grubba)  push_int(d_flag); d_flag = d;
a03d951997-10-14Fredrik Hübinette (Hubbe) }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl int _optimizer_debug(int(0..) level) *! *! Set the optimizer debug level. *! *! @returns *! The old optimizer debug level will be returned. *! *! @note *! This function is only available if the Pike runtime has been compiled *! with RTL debug. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__optimizer_debug(INT32 args)
bcc9181999-11-14Henrik Grubbström (Grubba) { INT_TYPE l; CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_optimizer_debug: permission denied.\n")); get_all_args("_optimizer_debug", args, "%i", &l); pop_n_elems(args); push_int(l_flag); l_flag = l; }
3dba602001-01-11Henrik Grubbström (Grubba)  /*! @decl int _assembler_debug(int(0..) level) *! *! Set the assembler debug level. *! *! @returns *! The old assembler debug level will be returned. *! *! @note *! This function is only available if the Pike runtime has been compiled *! with RTL debug. */ PMOD_EXPORT void f__assembler_debug(INT32 args) { INT_TYPE l; CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_assembler_debug: permission denied.\n")); get_all_args("_optimizer_debug", args, "%i", &l); pop_n_elems(args); push_int(a_flag); a_flag = l; }
2f54f71998-04-13Henrik Grubbström (Grubba) #ifdef YYDEBUG
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl int _compiler_trace(int(0..) level) *! *! Set the compiler trace level. *! *! @returns *! The old compiler trace level will be returned. *! *! @note *! This function is only available if the Pike runtime has been compiled *! with RTL debug. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__compiler_trace(INT32 args)
2f54f71998-04-13Henrik Grubbström (Grubba) { extern int yydebug;
5665ab1999-07-28Henrik Grubbström (Grubba)  INT_TYPE yyd;
d0d01b1999-03-20Henrik Grubbström (Grubba)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_compiler_trace: permission denied.\n"));
5665ab1999-07-28Henrik Grubbström (Grubba)  get_all_args("_compiler_trace", args, "%i", &yyd);
2f54f71998-04-13Henrik Grubbström (Grubba)  pop_n_elems(args);
5665ab1999-07-28Henrik Grubbström (Grubba)  push_int(yydebug); yydebug = yyd;
2f54f71998-04-13Henrik Grubbström (Grubba) } #endif /* YYDEBUG */
ed70b71996-06-09Fredrik Hübinette (Hubbe) #endif
fe91501998-07-26Peter J. Holzer #if defined(HAVE_LOCALTIME) || defined(HAVE_GMTIME) static void encode_struct_tm(struct tm *tm)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_string(make_shared_string("sec")); push_int(tm->tm_sec); push_string(make_shared_string("min")); push_int(tm->tm_min); push_string(make_shared_string("hour")); push_int(tm->tm_hour);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) 
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_string(make_shared_string("mday")); push_int(tm->tm_mday); push_string(make_shared_string("mon")); push_int(tm->tm_mon); push_string(make_shared_string("year")); push_int(tm->tm_year); push_string(make_shared_string("wday")); push_int(tm->tm_wday); push_string(make_shared_string("yday")); push_int(tm->tm_yday); push_string(make_shared_string("isdst")); push_int(tm->tm_isdst);
fe91501998-07-26Peter J. Holzer } #endif #ifdef HAVE_GMTIME
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl mapping(string:int) gmtime(int timestamp) *! *! Convert seconds since 1970 into components. *! *! This function works like @[localtime()] but the result is *! not adjusted for the local time zone. *! *! @seealso *! @[localtime()], @[time()], @[ctime()], @[mktime()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_gmtime(INT32 args)
fe91501998-07-26Peter J. Holzer { struct tm *tm;
d0d01b1999-03-20Henrik Grubbström (Grubba)  INT_TYPE tt;
fe91501998-07-26Peter J. Holzer  time_t t;
d0d01b1999-03-20Henrik Grubbström (Grubba)  get_all_args("gmtime", args, "%i", &tt); t = tt; tm = gmtime(&t);
fe91501998-07-26Peter J. Holzer  pop_n_elems(args); encode_struct_tm(tm); push_string(make_shared_string("timezone")); push_int(0); f_aggregate_mapping(20); } #endif #ifdef HAVE_LOCALTIME
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl mapping(string:int) localtime(int timestamp) *! *! Convert seconds since 1970 into components. *! *! @returns *! This function returns a mapping with the following components: *! @mapping *! @elem int(0..60) "sec" *! Seconds over the minute. *! @elem int(0..59) "min" *! Minutes over the hour. *! @elem int(0..23) "hour" *! Hour of the day. *! @elem int(1..31) "mday" *! Day of the month. *! @elem int(0..11) "mon" *! Month of the year. *! @elem int(0..) "year" *! Year since 1900. *! @elem int(0..6) "wday" *! Day of week (0 = Sunday). *! @elem int(0..365) "yday" *! Day of the year. *! @elem int(0..1) "isdst" *! Is daylight savings time. *! @elem int "timezone" *! Offset from UTC. *! @endmapping *! *! @note *! The field @tt{"timezone"@} may not be available on all platforms. *! *! @seealso *! @[Calendar], @[gmtime()], @[time()], @[ctime()], @[mktime()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_localtime(INT32 args)
fe91501998-07-26Peter J. Holzer { struct tm *tm;
d0d01b1999-03-20Henrik Grubbström (Grubba)  INT_TYPE tt;
fe91501998-07-26Peter J. Holzer  time_t t;
d0d01b1999-03-20Henrik Grubbström (Grubba)  get_all_args("localtime", args, "%i", &tt); t = tt; tm = localtime(&t);
fe91501998-07-26Peter J. Holzer  pop_n_elems(args); encode_struct_tm(tm);
3beb891996-06-21Fredrik Hübinette (Hubbe)  #ifdef HAVE_EXTERNAL_TIMEZONE push_string(make_shared_string("timezone")); push_int(timezone); f_aggregate_mapping(20); #else #ifdef STRUCT_TM_HAS_GMTOFF push_string(make_shared_string("timezone")); push_int(tm->tm_gmtoff); f_aggregate_mapping(20); #else f_aggregate_mapping(18); #endif
c5d9811996-05-16Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) }
3beb891996-06-21Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) 
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) #ifdef HAVE_MKTIME
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl int mktime(mapping(string:int) tm) *! @decl int mktime(int sec, int min, int hour, int mday, int mon, int year, *! int isdst, int tz) *! *! This function converts information about date and time into an integer *! which contains the number of seconds since the beginning of 1970. *! *! You can either call this function with a mapping containing the *! following elements: *! @mapping *! @elem int(0..60) "sec" *! Seconds over the minute. *! @elem int(0..59) "min" *! Minutes over the hour. *! @elem int(0..23) "hour" *! Hour of the day. *! @elem int(1..31) "mday" *! Day of the month. *! @elem int(0..11) "mon" *! Month of the year. *! @elem int(0..) "year" *! Year since 1900. *! @elem int(0..1) "isdst" *! Is daylight savings time. *! @elem int(-12..12) "timezone" *! The timezone offset from UTC in hours. *! @endmapping *! *! Or you can just send them all on one line as the second syntax suggests. *! *! @seealso *! @[time()], @[ctime()], @[localtime()], @[gmtime()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_mktime (INT32 args)
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) {
5665ab1999-07-28Henrik Grubbström (Grubba)  INT_TYPE sec, min, hour, mday, mon, year, isdst;
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  struct tm date; struct svalue s; struct svalue * r; int retval; if (args<1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("mktime", 1);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  if(args == 1) { MEMSET(&date, 0, sizeof(date)); push_text("sec"); push_text("min"); push_text("hour"); push_text("mday"); push_text("mon"); push_text("year"); push_text("isdst"); push_text("timezone"); f_aggregate(8); f_rows(2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; dmalloc_touch_svalue(Pike_sp); push_array_items(Pike_sp->u.array);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  args=8; }
5db18e1998-05-07Fredrik Hübinette (Hubbe)  get_all_args("mktime",args, "%i%i%i%i%i%i", &sec, &min, &hour, &mday, &mon, &year);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) 
5db18e1998-05-07Fredrik Hübinette (Hubbe)  MEMSET(&date, 0, sizeof(date));
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  date.tm_sec=sec; date.tm_min=min; date.tm_hour=hour; date.tm_mday=mday; date.tm_mon=mon; date.tm_year=year;
c69e411999-12-06Henrik Grubbström (Grubba) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if ((args > 6) && (Pike_sp[6-args].subtype == NUMBER_NUMBER))
5db18e1998-05-07Fredrik Hübinette (Hubbe)  {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  date.tm_isdst = Pike_sp[6-args].u.integer;
c69e411999-12-06Henrik Grubbström (Grubba)  } else {
5665ab1999-07-28Henrik Grubbström (Grubba)  date.tm_isdst = -1;
5db18e1998-05-07Fredrik Hübinette (Hubbe)  }
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  #if STRUCT_TM_HAS_GMTOFF
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if((args > 7) && (Pike_sp[7-args].subtype == NUMBER_NUMBER))
5db18e1998-05-07Fredrik Hübinette (Hubbe)  {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  date.tm_gmtoff=Pike_sp[7-args].u.intger;
5db18e1998-05-07Fredrik Hübinette (Hubbe)  }else{
5665ab1999-07-28Henrik Grubbström (Grubba)  time_t tmp = 0; data.tm_gmtoff=localtime(&tmp).tm_gmtoff;
5db18e1998-05-07Fredrik Hübinette (Hubbe)  }
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  retval=mktime(&date); #else #ifdef HAVE_EXTERNAL_TIMEZONE
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if((args > 7) && (Pike_sp[7-args].subtype == NUMBER_NUMBER))
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  retval=mktime(&date) + Pike_sp[7-args].u.integer - timezone;
2befad1997-01-28Fredrik Hübinette (Hubbe)  }else{ retval=mktime(&date);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  } #else retval=mktime(&date); #endif #endif if (retval == -1)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  PIKE_ERROR("mktime", "Cannot convert.\n", Pike_sp, args);
c69e411999-12-06Henrik Grubbström (Grubba)  pop_n_elems(args); push_int(retval);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) } #endif
42a92c1999-11-04Henrik Grubbström (Grubba) /* Parse a sprintf/sscanf-style format string */
93b7202000-08-14Henrik Grubbström (Grubba) static ptrdiff_t low_parse_format(p_wchar0 *s, ptrdiff_t slen)
42a92c1999-11-04Henrik Grubbström (Grubba) {
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t i; ptrdiff_t offset = 0;
42a92c1999-11-04Henrik Grubbström (Grubba)  int num_percent_percent = 0;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  struct svalue *old_sp = Pike_sp;
42a92c1999-11-04Henrik Grubbström (Grubba)  for (i=offset; i < slen; i++) { if (s[i] == '%') {
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t j;
42a92c1999-11-04Henrik Grubbström (Grubba)  if (i != offset) { push_string(make_shared_binary_string0(s + offset, i));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if ((Pike_sp != old_sp+1) && (Pike_sp[-2].type == T_STRING)) {
42a92c1999-11-04Henrik Grubbström (Grubba)  /* Concat. */ f_add(2); } } for (j = i+1;j<slen;j++) { int c = s[j]; switch(c) { /* Flags */ case '!': case '#': case '$': case '-': case '/': case '0': case '=': case '>': case '@': case '^': case '_': case '|': continue; /* Padding */ case ' ': case '\'': case '+': case '~': break; /* Attributes */ case '.': case ':': case ';': continue; /* Attribute value */ case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': continue; /* Specials */ case '%': push_constant_text("%");
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if ((Pike_sp != old_sp+1) && (Pike_sp[-2].type == T_STRING)) {
42a92c1999-11-04Henrik Grubbström (Grubba)  /* Concat. */ f_add(2); } break; case '{': i = j + 1 + low_parse_format(s + j + 1, slen - (j+1)); f_aggregate(1); if ((i + 2 >= slen) || (s[i] != '%') || (s[i+1] != '}')) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("parse_format(): Expected %%}.\n");
42a92c1999-11-04Henrik Grubbström (Grubba)  } i += 2; break; case '}':
93b7202000-08-14Henrik Grubbström (Grubba)  f_aggregate(DO_NOT_WARN(Pike_sp - old_sp));
42a92c1999-11-04Henrik Grubbström (Grubba)  return i; /* Set */ case '[': break; /* Argument */ default: break; } break; } if (j == slen) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("parse_format(): Unterminated %%-expression.\n");
42a92c1999-11-04Henrik Grubbström (Grubba)  } offset = i = j; } } if (i != offset) { push_string(make_shared_binary_string0(s + offset, i));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if ((Pike_sp != old_sp+1) && (Pike_sp[-2].type == T_STRING)) {
42a92c1999-11-04Henrik Grubbström (Grubba)  /* Concat. */ f_add(2); } }
93b7202000-08-14Henrik Grubbström (Grubba)  f_aggregate(DO_NOT_WARN(Pike_sp - old_sp));
42a92c1999-11-04Henrik Grubbström (Grubba)  return i; }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl array parse_format(string fmt) *!
7cb4e42001-01-09Henrik Grubbström (Grubba)  *! Parses a sprintf/sscanf-style format string
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
42a92c1999-11-04Henrik Grubbström (Grubba) static void f_parse_format(INT32 args) { struct pike_string *s = NULL; struct array *a;
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t len;
42a92c1999-11-04Henrik Grubbström (Grubba)  get_all_args("parse_format", args, "%W", &s); len = low_parse_format(STR0(s), s->len); if (len != s->len) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("parse_format(): Unexpected %%} in format string at offset %ld\n",
69bb402000-08-17Henrik Grubbström (Grubba)  PTRDIFF_T_TO_LONG(len));
42a92c1999-11-04Henrik Grubbström (Grubba)  } #ifdef PIKE_DEBUG
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-1].type != T_ARRAY) {
42a92c1999-11-04Henrik Grubbström (Grubba)  fatal("parse_format(): Unexpected result from low_parse_format()\n"); } #endif /* PIKE_DEBUG */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a = (--Pike_sp)->u.array;
42a92c1999-11-04Henrik Grubbström (Grubba)  debug_malloc_touch(a); pop_n_elems(args); push_array(a); }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
156fd51997-10-27Fredrik Hübinette (Hubbe) /* Check if the string s[0..len[ matches the glob m[0..mlen[ */
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) static int does_match(struct pike_string *s,int j, struct pike_string *m,int i)
ed70b71996-06-09Fredrik Hübinette (Hubbe) {
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  for (; i<m->len; i++)
ed70b71996-06-09Fredrik Hübinette (Hubbe)  {
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  switch (index_shared_string(m,i))
ed70b71996-06-09Fredrik Hübinette (Hubbe)  {
7a1bed1996-12-01Fredrik Hübinette (Hubbe)  case '?':
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if(j++>=s->len) return 0;
7a1bed1996-12-01Fredrik Hübinette (Hubbe)  break;
ed70b71996-06-09Fredrik Hübinette (Hubbe)  case '*': i++;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if (i==m->len) return 1; /* slut */
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  for (;j<s->len;j++) if (does_match(s,j,m,i))
ed70b71996-06-09Fredrik Hübinette (Hubbe)  return 1; return 0; default:
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if(j>=s->len || index_shared_string(m,i)!=index_shared_string(s,j)) return 0;
7a1bed1996-12-01Fredrik Hübinette (Hubbe)  j++;
ed70b71996-06-09Fredrik Hübinette (Hubbe)  } }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  return j==s->len;
ed70b71996-06-09Fredrik Hübinette (Hubbe) }
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl int(0..1) glob(string glob, string str) *! @decl array(string) glob(string glob, array(string) arr) *! *! Match strings against globs. *! *! In a glob string a question sign matches any character and *! an asterisk matches any string. *! *! When the second argument is a string and @[str] matches *! the glob @[glob] @tt{1@} will be returned, @tt{0@} (zero) otherwise. *! *! If the second array is an array and array containing the strings in *! @[arr] that match @[glob] will be returned. *! *! @seealso *! @[sscanf()], @[Regexp] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_glob(INT32 args)
ed70b71996-06-09Fredrik Hübinette (Hubbe) { INT32 i,matches; struct array *a;
3beb891996-06-21Fredrik Hübinette (Hubbe)  struct svalue *sval, tmp;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *glob;
ed70b71996-06-09Fredrik Hübinette (Hubbe)  if(args < 2)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("glob", 2);
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(args > 2) pop_n_elems(args-2);
3beb891996-06-21Fredrik Hübinette (Hubbe)  args=2;
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-args].type!=T_STRING)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("glob", 1, "string");
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  glob=Pike_sp[-args].u.string;
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch(Pike_sp[1-args].type)
ed70b71996-06-09Fredrik Hübinette (Hubbe)  { case T_STRING:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  i=does_match(Pike_sp[1-args].u.string,0,glob,0);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_int(i); break; case T_ARRAY:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  a=Pike_sp[1-args].u.array;
3beb891996-06-21Fredrik Hübinette (Hubbe)  matches=0;
ed70b71996-06-09Fredrik Hübinette (Hubbe)  for(i=0;i<a->size;i++) {
5635941997-09-10Fredrik Hübinette (Hubbe)  if(ITEM(a)[i].type != T_STRING)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("glob", 2, "string|array(string)");
5635941997-09-10Fredrik Hübinette (Hubbe) 
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if(does_match(ITEM(a)[i].u.string,0,glob,0))
ed70b71996-06-09Fredrik Hübinette (Hubbe)  {
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(ITEM(a)[i].u.string);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  push_string(ITEM(a)[i].u.string); matches++; } } f_aggregate(matches);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  tmp=Pike_sp[-1]; Pike_sp--; dmalloc_touch_svalue(Pike_sp);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  pop_n_elems(2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp[0]=tmp; Pike_sp++;
ed70b71996-06-09Fredrik Hübinette (Hubbe)  break; default:
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("glob", 1, "string|array(string)");
ed70b71996-06-09Fredrik Hübinette (Hubbe)  } }
a7759e1998-11-17Henrik Grubbström (Grubba) /* comb_merge */
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @module Array */ /*! @decl array(int) interleave_array(array(mapping(int:mixed)) tab) *! *! Interleave a sparse matrix. *! *! Returns an array with offsets that describe how to interleave *! the rows of @[tab]. */
a7759e1998-11-17Henrik Grubbström (Grubba) static void f_interleave_array(INT32 args) { struct array *arr = NULL; struct array *min = NULL; struct array *order = NULL; int max = 0; int ok; int nelems = 0; int i; get_all_args("interleave_array", args, "%a", &arr); /* We're not interrested in any other arguments. */ pop_n_elems(args-1); if ((ok = arr->type_field & BIT_MAPPING) && (arr->type_field & ~BIT_MAPPING)) { /* Might be ok, but do some more checking... */ for(i = 0; i < arr->size; i++) { if (ITEM(arr)[i].type != T_MAPPING) { ok = 0; break; } } } if (!ok) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("interleave_array", 1, "array(mapping(int:mixed))");
a7759e1998-11-17Henrik Grubbström (Grubba)  } /* The order array */ ref_push_array(arr); f_indices(1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  order = Pike_sp[-1].u.array;
a7759e1998-11-17Henrik Grubbström (Grubba)  /* The min array */ push_array(min = allocate_array(arr->size)); /* Initialize the min array */ for (i = 0; i < arr->size; i++) { struct mapping *m; /* e and k are used by MAPPING_LOOP() */ INT32 e; struct keypair *k; INT_TYPE low = 0x7fffffff;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
a7759e1998-11-17Henrik Grubbström (Grubba)  if (ITEM(arr)[i].type != T_MAPPING) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("interleave_array(): Element %d is not a mapping!\n", i);
a7759e1998-11-17Henrik Grubbström (Grubba)  }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
a7759e1998-11-17Henrik Grubbström (Grubba)  m = ITEM(arr)[i].u.mapping; MAPPING_LOOP(m) { if (k->ind.type != T_INT) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("interleave_array(): Index not an integer in mapping %d!\n", i);
a7759e1998-11-17Henrik Grubbström (Grubba)  } if (low > k->ind.u.integer) { low = k->ind.u.integer; if (low < 0) {
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("interleave_array(): Index %d in mapping %d is negative!\n",
a7759e1998-11-17Henrik Grubbström (Grubba)  low, i); } } if (max < k->ind.u.integer) { max = k->ind.u.integer; } nelems++; } /* FIXME: Is this needed? Isn't T_INT default? */ ITEM(min)[i].u.integer = low; } ref_push_array(order); f_sort(2); /* Sort the order array on the minimum index */ /* State on stack now: * * array(mapping(int:mixed)) arr * array(int) order * array(int) min (now sorted) */ /* Now we can start with the real work... */ { char *tab; int size; int minfree = 0; /* Initialize the lookup table */ max += 1; max *= 2; /* max will be the padding at the end. */ size = (nelems + max) * 8; /* Initial size */ if (!(tab = malloc(size + max))) {
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_OUT_OF_MEMORY_ERROR("interleave_array", size+max);
a7759e1998-11-17Henrik Grubbström (Grubba)  } MEMSET(tab, 0, size + max); for (i = 0; i < order->size; i++) { int low = ITEM(min)[i].u.integer; int j = ITEM(order)[i].u.integer; int offset = 0; struct mapping *m; INT32 e; struct keypair *k;
6168ce2000-01-27Fredrik Hübinette (Hubbe)  if (! m_sizeof(m = ITEM(arr)[j].u.mapping)) {
a7759e1998-11-17Henrik Grubbström (Grubba)  /* Not available */ ITEM(min)[i].u.integer = -1; continue; } if (low < minfree) { offset = minfree - low; } else { minfree = offset; } ok = 0; while (!ok) { ok = 1; MAPPING_LOOP(m) { int ind = k->ind.u.integer; if (tab[offset + ind]) { ok = 0; while (tab[++offset + ind]) ; } } } MAPPING_LOOP(m) { tab[offset + k->ind.u.integer] = 1; } while(tab[minfree]) { minfree++; } ITEM(min)[i].u.integer = offset; /* Check need for realloc */ if (offset >= size) { char *newtab = realloc(tab, size*2 + max); if (!newtab) { free(tab);
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("interleave_array(): Couldn't extend table!\n");
a7759e1998-11-17Henrik Grubbström (Grubba)  } tab = newtab; MEMSET(tab + size + max, 0, size); size = size * 2; } } free(tab); } /* We want these two to survive the stackpopping. */ add_ref(min); add_ref(order); pop_n_elems(3); /* Return value */ ref_push_array(min); /* Restore the order */ push_array(order); push_array(min); f_sort(2); pop_stack(); }
7ce3a91998-02-12Henrik Grubbström (Grubba) /* longest_ordered_sequence */ static int find_gt(struct array *a, int i, int *stack, int top) { struct svalue *x = a->item + i; int l,h; if (!top || !is_lt(x, a->item + stack[top - 1])) return top; l = 0; h = top; while (l < h) { int middle = (l + h)/2; if (!is_gt(a->item + stack[middle], x)) { l = middle+1; } else { h = middle; } } return l; } static struct array *longest_ordered_sequence(struct array *a) { int *stack; int *links; int i,j,top=0,l=0,ltop=-1; struct array *res; ONERROR tmp; ONERROR tmp2;
c055781999-05-11Fredrik Hübinette (Hubbe)  if(!a->size) return allocate_array(0);
7ce3a91998-02-12Henrik Grubbström (Grubba)  stack = malloc(sizeof(int)*a->size); links = malloc(sizeof(int)*a->size); if (!stack || !links) { if (stack) free(stack); if (links) free(links); return 0; } /* is_gt(), is_lt() and low_allocate_array() can generate errors. */ SET_ONERROR(tmp, free, stack); SET_ONERROR(tmp2, free, links); for (i=0; i<a->size; i++) { int pos; pos = find_gt(a, i, stack, top); if (pos == top) { top++; ltop = i; } if (pos != 0) links[i] = stack[pos-1]; else links[i] = -1; stack[pos] = i; }
a4a1722000-12-05Per Hedbor  /* FIXME(?) memory unfreed upon error here */
7ce3a91998-02-12Henrik Grubbström (Grubba)  res = low_allocate_array(top, 0); while (ltop != -1) { res->item[--top].u.integer = ltop; ltop = links[ltop]; } UNSET_ONERROR(tmp2); UNSET_ONERROR(tmp); free(stack); free(links); return res; }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array(int) longest_ordered_sequence(array a) *! *! Find the longest ordered sequence of elements. *! *! This function returns an array of the indices in the longest *! ordered sequence of elements in the array. *! *! @seealso *! @[diff()] */
7ce3a91998-02-12Henrik Grubbström (Grubba) static void f_longest_ordered_sequence(INT32 args) { struct array *a = NULL; get_all_args("Array.longest_ordered_sequence", args, "%a", &a); /* THREADS_ALLOW(); */ a = longest_ordered_sequence(a); /* THREADS_DISALLOW(); */ if (!a) {
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_OUT_OF_MEMORY_ERROR("Array.longest_ordered_sequence", (int)sizeof(int *)*a->size*2);
7ce3a91998-02-12Henrik Grubbström (Grubba)  } pop_n_elems(args); push_array(a); }
088e2e1998-02-12Mirar (Pontus Hagland) /**** diff ************************************************************/
f873831998-05-19Henrik Grubbström (Grubba) static struct array* diff_compare_table(struct array *a,struct array *b,int *u)
088e2e1998-02-12Mirar (Pontus Hagland) { struct array *res; struct mapping *map; struct svalue *pval; int i;
f873831998-05-19Henrik Grubbström (Grubba)  if (u) { *u = 0; /* Unique rows in array b */ }
088e2e1998-02-12Mirar (Pontus Hagland)  map=allocate_mapping(256); push_mapping(map); /* in case of out of memory */ for (i=0; i<b->size; i++) { pval=low_mapping_lookup(map,b->item+i); if (!pval) { struct svalue val; val.type=T_ARRAY; val.u.array=low_allocate_array(1,1); val.u.array->item[0].type=T_INT; val.u.array->item[0].subtype=NUMBER_NUMBER; val.u.array->item[0].u.integer=i; mapping_insert(map,b->item+i,&val); free_svalue(&val);
f873831998-05-19Henrik Grubbström (Grubba)  if (u) { (*u)++; }
088e2e1998-02-12Mirar (Pontus Hagland)  } else { pval->u.array=resize_array(pval->u.array,pval->u.array->size+1); pval->u.array->item[pval->u.array->size-1].type=T_INT; pval->u.array->item[pval->u.array->size-1].subtype=NUMBER_NUMBER; pval->u.array->item[pval->u.array->size-1].u.integer=i; } } res=low_allocate_array(a->size,0); for (i=0; i<a->size; i++) { pval=low_mapping_lookup(map,a->item+i); if (!pval) { res->item[i].type=T_ARRAY;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(res->item[i].u.array=&empty_array);
088e2e1998-02-12Mirar (Pontus Hagland)  } else { assign_svalue(res->item+i,pval); } } pop_stack(); return res; }
7083e31998-02-15Mirar (Pontus Hagland) struct diff_magic_link { int x; int refs; struct diff_magic_link *prev; }; struct diff_magic_link_pool { struct diff_magic_link *firstfree; struct diff_magic_link_pool *next; int firstfreenum; struct diff_magic_link dml[1]; };
f873831998-05-19Henrik Grubbström (Grubba) struct diff_magic_link_head { unsigned int depth; struct diff_magic_link *link; };
7083e31998-02-15Mirar (Pontus Hagland) #define DMLPOOLSIZE 16384 static int dmls=0; static INLINE struct diff_magic_link_pool* dml_new_pool(struct diff_magic_link_pool **pools) { struct diff_magic_link_pool *new;
088e2e1998-02-12Mirar (Pontus Hagland) 
7083e31998-02-15Mirar (Pontus Hagland)  new=malloc(sizeof(struct diff_magic_link_pool)+ sizeof(struct diff_magic_link)*DMLPOOLSIZE); if (!new) return NULL; /* fail */ new->firstfreenum=0; new->firstfree=NULL; new->next=*pools; *pools=new; return *pools; } static INLINE struct diff_magic_link* dml_new(struct diff_magic_link_pool **pools) { struct diff_magic_link *new; struct diff_magic_link_pool *pool; dmls++; if ( *pools && (new=(*pools)->firstfree) ) { (*pools)->firstfree=new->prev; new->prev=NULL; return new; } pool=*pools; while (pool) { if (pool->firstfreenum<DMLPOOLSIZE) return pool->dml+(pool->firstfreenum++); pool=pool->next; } if ( (pool=dml_new_pool(pools)) ) { pool->firstfreenum=1; return pool->dml; } return NULL; } static INLINE void dml_free_pools(struct diff_magic_link_pool *pools) { struct diff_magic_link_pool *pool; while (pools) { pool=pools->next; free(pools); pools=pool; } } static INLINE void dml_delete(struct diff_magic_link_pool *pools, struct diff_magic_link *dml) { if (dml->prev && !--dml->prev->refs) dml_delete(pools,dml->prev); dmls--; dml->prev=pools->firstfree; pools->firstfree=dml; } static INLINE int diff_ponder_stack(int x, struct diff_magic_link **dml, int top) { int middle,a,b; a=0; b=top; while (b>a) { middle=(a+b)/2; if (dml[middle]->x<x) a=middle+1; else if (dml[middle]->x>x) b=middle; else return middle; } if (a<top && dml[a]->x<x) a++; return a; } static INLINE int diff_ponder_array(int x, struct svalue *arr, int top)
088e2e1998-02-12Mirar (Pontus Hagland) { int middle,a,b; a=0; b=top; while (b>a) { middle=(a+b)/2;
7083e31998-02-15Mirar (Pontus Hagland)  if (arr[middle].u.integer<x) a=middle+1; else if (arr[middle].u.integer>x) b=middle;
088e2e1998-02-12Mirar (Pontus Hagland)  else return middle; }
7083e31998-02-15Mirar (Pontus Hagland)  if (a<top && arr[a].u.integer<x) a++;
088e2e1998-02-12Mirar (Pontus Hagland)  return a; }
69faad1998-03-16Henrik Grubbström (Grubba) /* * The Grubba-Mirar Longest Common Sequence algorithm. * * This algorithm is O((Na * Nb / K)*lg(Na * Nb / K)), where: * * Na == sizeof(a) * Nb == sizeof(b) * K == sizeof(correlation(a,b)) * * For binary data: * K == 256 => O(Na * Nb * lg(Na * Nb)), * Na ~= Nb ~= N => O(N² * lg(N)) * * For ascii data: * K ~= C * min(Na, Nb), C constant => O(max(Na, Nb)*lg(max(Na,Nb))), * Na ~= Nb ~= N => O(N * lg(N)) * * diff_longest_sequence() takes two arguments: * cmptbl == diff_compare_table(a, b) * blen == sizeof(b) >= max(@(cmptbl*({}))) */
f873831998-05-19Henrik Grubbström (Grubba) static struct array *diff_longest_sequence(struct array *cmptbl, int blen)
088e2e1998-02-12Mirar (Pontus Hagland) {
7083e31998-02-15Mirar (Pontus Hagland)  int i,j,top=0,lsize=0;
088e2e1998-02-12Mirar (Pontus Hagland)  struct array *a;
7083e31998-02-15Mirar (Pontus Hagland)  struct diff_magic_link_pool *pools=NULL; struct diff_magic_link *dml; struct diff_magic_link **stack;
7be6851998-02-24Henrik Grubbström (Grubba)  char *marks;
088e2e1998-02-12Mirar (Pontus Hagland) 
c055781999-05-11Fredrik Hübinette (Hubbe)  if(!cmptbl->size) return allocate_array(0);
69faad1998-03-16Henrik Grubbström (Grubba)  stack = malloc(sizeof(struct diff_magic_link*)*cmptbl->size);
088e2e1998-02-12Mirar (Pontus Hagland) 
54db6c1999-03-27Henrik Grubbström (Grubba)  if (!stack) { int args = 0; SIMPLE_OUT_OF_MEMORY_ERROR("diff_longest_sequence", (int)sizeof(struct diff_magic_link*) * cmptbl->size); }
088e2e1998-02-12Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba)  /* NB: marks is used for optimization purposes only */
54db6c1999-03-27Henrik Grubbström (Grubba)  marks = calloc(blen, 1);
7be6851998-02-24Henrik Grubbström (Grubba) 
c055781999-05-11Fredrik Hübinette (Hubbe)  if (!marks && blen) {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 0;
7be6851998-02-24Henrik Grubbström (Grubba)  free(stack);
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_OUT_OF_MEMORY_ERROR("diff_longest_sequence", blen);
7be6851998-02-24Henrik Grubbström (Grubba)  }
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "\n\nDIFF: sizeof(cmptbl)=%d, blen=%d\n", cmptbl->size, blen); #endif /* DIFF_DEBUG */ for (i = 0; i<cmptbl->size; i++)
7083e31998-02-15Mirar (Pontus Hagland)  { struct svalue *inner=cmptbl->item[i].u.array->item;
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: i=%d\n", i); #endif /* DIFF_DEBUG */ for (j = cmptbl->item[i].u.array->size; j--;)
088e2e1998-02-12Mirar (Pontus Hagland)  {
69faad1998-03-16Henrik Grubbström (Grubba)  int x = inner[j].u.integer;
7083e31998-02-15Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: j=%d, x=%d\n", j, x); #endif /* DIFF_DEBUG */
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
978c1c1998-03-18Henrik Grubbström (Grubba)  if (x >= blen) { fatal("diff_longest_sequence(): x:%d >= blen:%d\n", x, blen); } else if (x < 0) { fatal("diff_longest_sequence(): x:%d < 0\n", x); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
7be6851998-02-24Henrik Grubbström (Grubba)  if (!marks[x]) { int pos; if (top && x<=stack[top-1]->x) {
69faad1998-03-16Henrik Grubbström (Grubba)  /* Find the insertion point. */ pos = diff_ponder_stack(x, stack, top);
7be6851998-02-24Henrik Grubbström (Grubba)  if (pos != top) {
69faad1998-03-16Henrik Grubbström (Grubba)  /* Not on the stack anymore. */
7be6851998-02-24Henrik Grubbström (Grubba)  marks[stack[pos]->x] = 0; } } else pos=top;
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: pos=%d\n", pos); #endif /* DIFF_DEBUG */ /* This part is only optimization (j accelleration). */
7be6851998-02-24Henrik Grubbström (Grubba)  if (pos && j) { if (!marks[inner[j-1].u.integer]) {
69faad1998-03-16Henrik Grubbström (Grubba)  /* Find the element to insert. */ j = diff_ponder_array(stack[pos-1]->x+1, inner, j); x = inner[j].u.integer;
7be6851998-02-24Henrik Grubbström (Grubba)  } } else {
69faad1998-03-16Henrik Grubbström (Grubba)  j = 0; x = inner->u.integer;
7be6851998-02-24Henrik Grubbström (Grubba)  }
69faad1998-03-16Henrik Grubbström (Grubba)  #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: New j=%d, x=%d\n", j, x); #endif /* DIFF_DEBUG */
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
978c1c1998-03-18Henrik Grubbström (Grubba)  if (x >= blen) { fatal("diff_longest_sequence(): x:%d >= blen:%d\n", x, blen); } else if (x < 0) { fatal("diff_longest_sequence(): x:%d < 0\n", x); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
69faad1998-03-16Henrik Grubbström (Grubba)  /* Put x on the stack. */
7be6851998-02-24Henrik Grubbström (Grubba)  marks[x] = 1;
69faad1998-03-16Henrik Grubbström (Grubba)  if (pos == top)
7be6851998-02-24Henrik Grubbström (Grubba)  {
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: New top element\n"); #endif /* DIFF_DEBUG */
7be6851998-02-24Henrik Grubbström (Grubba)  if (! (dml=dml_new(&pools)) ) {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 0;
7083e31998-02-15Mirar (Pontus Hagland)  dml_free_pools(pools); free(stack);
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_OUT_OF_MEMORY_ERROR("diff_longest_sequence", sizeof(struct diff_magic_link_pool) + sizeof(struct diff_magic_link) * DMLPOOLSIZE);
7be6851998-02-24Henrik Grubbström (Grubba)  }
7083e31998-02-15Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba)  dml->x = x; dml->refs = 1;
7083e31998-02-15Mirar (Pontus Hagland) 
7be6851998-02-24Henrik Grubbström (Grubba)  if (pos)
f873831998-05-19Henrik Grubbström (Grubba)  (dml->prev = stack[pos-1])->refs++;
7be6851998-02-24Henrik Grubbström (Grubba)  else
69faad1998-03-16Henrik Grubbström (Grubba)  dml->prev = NULL;
7083e31998-02-15Mirar (Pontus Hagland) 
7be6851998-02-24Henrik Grubbström (Grubba)  top++;
7083e31998-02-15Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba)  stack[pos] = dml; } else if (pos && stack[pos]->refs == 1 && stack[pos-1] == stack[pos]->prev) { #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: Optimized case\n"); #endif /* DIFF_DEBUG */ /* Optimization. */ stack[pos]->x = x; } else { #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: Generic case\n"); #endif /* DIFF_DEBUG */ if (! (dml=dml_new(&pools)) )
7be6851998-02-24Henrik Grubbström (Grubba)  {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 0;
69faad1998-03-16Henrik Grubbström (Grubba)  dml_free_pools(pools); free(stack);
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_OUT_OF_MEMORY_ERROR("diff_longest_sequence", sizeof(struct diff_magic_link_pool) + sizeof(struct diff_magic_link) * DMLPOOLSIZE);
7be6851998-02-24Henrik Grubbström (Grubba)  }
69faad1998-03-16Henrik Grubbström (Grubba)  dml->x = x; dml->refs = 1; if (pos)
f873831998-05-19Henrik Grubbström (Grubba)  (dml->prev = stack[pos-1])->refs++;
7be6851998-02-24Henrik Grubbström (Grubba)  else
69faad1998-03-16Henrik Grubbström (Grubba)  dml->prev = NULL; if (!--stack[pos]->refs) dml_delete(pools, stack[pos]);
7083e31998-02-15Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba)  stack[pos] = dml; } #ifdef DIFF_DEBUG } else { fprintf(stderr, "DIFF: Already marked (%d)!\n", marks[x]); #endif /* DIFF_DEBUG */
7be6851998-02-24Henrik Grubbström (Grubba)  }
088e2e1998-02-12Mirar (Pontus Hagland)  }
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG for(j=0; j < top; j++) { fprintf(stderr, "DIFF: stack:%d, mark:%d\n", stack[j]->x, marks[stack[j]->x]); } #endif /* DIFF_DEBUG */
7083e31998-02-15Mirar (Pontus Hagland)  }
088e2e1998-02-12Mirar (Pontus Hagland) 
7be6851998-02-24Henrik Grubbström (Grubba)  /* No need for marks anymore. */ free(marks);
a4a1722000-12-05Per Hedbor  /* FIXME(?) memory unfreed upon error here. */
088e2e1998-02-12Mirar (Pontus Hagland)  a=low_allocate_array(top,0);
7083e31998-02-15Mirar (Pontus Hagland)  if (top)
088e2e1998-02-12Mirar (Pontus Hagland)  {
7083e31998-02-15Mirar (Pontus Hagland)  dml=stack[top-1]; while (dml) { a->item[--top].u.integer=dml->x; dml=dml->prev; }
088e2e1998-02-12Mirar (Pontus Hagland)  } free(stack);
7083e31998-02-15Mirar (Pontus Hagland)  dml_free_pools(pools);
088e2e1998-02-12Mirar (Pontus Hagland)  return a; }
f873831998-05-19Henrik Grubbström (Grubba) /* * The dynamic programming Longest Common Sequence algorithm. * * This algorithm is O(Na * Nb), where: * * Na == sizeof(a) * Nb == sizeof(b) * * This makes it faster than the G-M algorithm on binary data, * but slower on ascii data.
c337d91998-05-19Henrik Grubbström (Grubba)  * * NOT true! The G-M algorithm seems to be faster on most data anyway. * /grubba 1998-05-19
f873831998-05-19Henrik Grubbström (Grubba)  */
bde0ef1998-05-19Henrik Grubbström (Grubba) static struct array *diff_dyn_longest_sequence(struct array *cmptbl, int blen)
f873831998-05-19Henrik Grubbström (Grubba) { struct array *res = NULL; struct diff_magic_link_head *table = NULL; struct diff_magic_link_pool *dml_pool = NULL; struct diff_magic_link *dml;
bde0ef1998-05-19Henrik Grubbström (Grubba)  unsigned int sz = (unsigned int)cmptbl->size; unsigned int i;
f873831998-05-19Henrik Grubbström (Grubba)  unsigned int off1 = 0;
bde0ef1998-05-19Henrik Grubbström (Grubba)  unsigned int off2 = blen + 1;
92bb061998-05-19Henrik Grubbström (Grubba)  unsigned int l1 = 0; unsigned int l2 = 0;
bde0ef1998-05-19Henrik Grubbström (Grubba)  table = calloc(sizeof(struct diff_magic_link_head)*2, off2); if (!table) {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 0; SIMPLE_OUT_OF_MEMORY_ERROR("diff_dyn_longest_sequence", sizeof(struct diff_magic_link_head) * 2 * off2);
bde0ef1998-05-19Henrik Grubbström (Grubba)  } /* FIXME: Assumes NULL is represented with all zeroes */ /* NOTE: Scan strings backwards to get the same result as the G-M * algorithm. */ for (i = sz; i--;) { struct array *boff = cmptbl->item[i].u.array; #ifdef DIFF_DEBUG fprintf(stderr, " i:%d\n", i); #endif /* DIFF_DEBUG */
f873831998-05-19Henrik Grubbström (Grubba) 
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (boff->size) { unsigned int bi; unsigned int base = blen; unsigned int tmp = off1;
f873831998-05-19Henrik Grubbström (Grubba)  off1 = off2; off2 = tmp;
bde0ef1998-05-19Henrik Grubbström (Grubba)  for (bi = boff->size; bi--;) { unsigned int ib = boff->item[bi].u.integer; #ifdef DIFF_DEBUG fprintf(stderr, " Range [%d - %d] differ\n", base - 1, ib + 1); #endif /* DIFF_DEBUG */ while ((--base) > ib) {
f873831998-05-19Henrik Grubbström (Grubba)  /* Differ */
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (table[off1 + base].link) { if (!--(table[off1 + base].link->refs)) { dml_delete(dml_pool, table[off1 + base].link); } }
f873831998-05-19Henrik Grubbström (Grubba)  /* FIXME: Should it be > or >= here to get the same result * as with the G-M algorithm? */
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (table[off2 + base].depth > table[off1 + base + 1].depth) { table[off1 + base].depth = table[off2 + base].depth; dml = (table[off1 + base].link = table[off2 + base].link);
f873831998-05-19Henrik Grubbström (Grubba)  } else {
bde0ef1998-05-19Henrik Grubbström (Grubba)  table[off1 + base].depth = table[off1 + base + 1].depth; dml = (table[off1 + base].link = table[off1 + base + 1].link);
f873831998-05-19Henrik Grubbström (Grubba)  } if (dml) { dml->refs++; } }
bde0ef1998-05-19Henrik Grubbström (Grubba)  /* Equal */
f873831998-05-19Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  fprintf(stderr, " Equal\n");
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */ if (table[off1 + ib].link) { if (!--(table[off1 + ib].link->refs)) { dml_delete(dml_pool, table[off1 + ib].link); } }
bde0ef1998-05-19Henrik Grubbström (Grubba)  table[off1 + ib].depth = table[off2 + ib + 1].depth + 1; dml = (table[off1 + ib].link = dml_new(&dml_pool)); if (!dml) {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 0;
bde0ef1998-05-19Henrik Grubbström (Grubba)  dml_free_pools(dml_pool); free(table);
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_OUT_OF_MEMORY_ERROR("diff_dyn_longest_sequence", sizeof(struct diff_magic_link_pool) + sizeof(struct diff_magic_link) * DMLPOOLSIZE);
bde0ef1998-05-19Henrik Grubbström (Grubba)  } dml->refs = 1; dml->prev = table[off2 + ib + 1].link; if (dml->prev) { dml->prev->refs++; } dml->x = ib; }
f873831998-05-19Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  fprintf(stderr, " Range [0 - %d] differ\n", base-1);
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */
bde0ef1998-05-19Henrik Grubbström (Grubba)  while (base--) { /* Differ */ if (table[off1 + base].link) { if (!--(table[off1 + base].link->refs)) { dml_delete(dml_pool, table[off1 + base].link);
f873831998-05-19Henrik Grubbström (Grubba)  }
bde0ef1998-05-19Henrik Grubbström (Grubba)  } /* FIXME: Should it be > or >= here to get the same result * as with the G-M algorithm? */ if (table[off2 + base].depth > table[off1 + base + 1].depth) { table[off1 + base].depth = table[off2 + base].depth; dml = (table[off1 + base].link = table[off2 + base].link);
f873831998-05-19Henrik Grubbström (Grubba)  } else {
bde0ef1998-05-19Henrik Grubbström (Grubba)  table[off1 + base].depth = table[off1 + base + 1].depth; dml = (table[off1 + base].link = table[off1 + base + 1].link); } if (dml) { dml->refs++;
f873831998-05-19Henrik Grubbström (Grubba)  } } } } /* Convert table into res */
bde0ef1998-05-19Henrik Grubbström (Grubba)  sz = table[off1].depth;
f873831998-05-19Henrik Grubbström (Grubba)  dml = table[off1].link; free(table); #ifdef DIFF_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  fprintf(stderr, "Result array size:%d\n", sz);
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */
bde0ef1998-05-19Henrik Grubbström (Grubba)  res = allocate_array(sz);
f873831998-05-19Henrik Grubbström (Grubba)  if (!res) {
54db6c1999-03-27Henrik Grubbström (Grubba)  int args = 0;
f873831998-05-19Henrik Grubbström (Grubba)  if (dml_pool) { dml_free_pools(dml_pool); }
54db6c1999-03-27Henrik Grubbström (Grubba)  SIMPLE_OUT_OF_MEMORY_ERROR("diff_dyn_longest_sequence", sizeof(struct array) + sz*sizeof(struct svalue));
f873831998-05-19Henrik Grubbström (Grubba)  }
bde0ef1998-05-19Henrik Grubbström (Grubba)  i = 0;
f873831998-05-19Henrik Grubbström (Grubba)  while(dml) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (i >= sz) {
a4a1722000-12-05Per Hedbor  fatal("Consistency error in diff_dyn_longest_sequence()\n");
f873831998-05-19Henrik Grubbström (Grubba)  }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
f873831998-05-19Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  fprintf(stderr, " %02d: %d\n", i, dml->x);
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */
bde0ef1998-05-19Henrik Grubbström (Grubba)  res->item[i].type = T_INT; res->item[i].subtype = 0; res->item[i].u.integer = dml->x;
f873831998-05-19Henrik Grubbström (Grubba)  dml = dml->prev;
bde0ef1998-05-19Henrik Grubbström (Grubba)  i++;
f873831998-05-19Henrik Grubbström (Grubba)  }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (i != sz) {
a4a1722000-12-05Per Hedbor  fatal("Consistency error in diff_dyn_longest_sequence()\n");
f873831998-05-19Henrik Grubbström (Grubba)  }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
f873831998-05-19Henrik Grubbström (Grubba)  dml_free_pools(dml_pool); return(res); }
088e2e1998-02-12Mirar (Pontus Hagland) static struct array* diff_build(struct array *a, struct array *b, struct array *seq) { struct array *ad,*bd;
393a592000-08-16Henrik Grubbström (Grubba)  ptrdiff_t bi, ai, lbi, lai, i, eqstart;
088e2e1998-02-12Mirar (Pontus Hagland) 
a4a1722000-12-05Per Hedbor  /* FIXME(?) memory unfreed upon error here (and later) */
088e2e1998-02-12Mirar (Pontus Hagland)  ad=low_allocate_array(0,32); bd=low_allocate_array(0,32); eqstart=0; lbi=bi=ai=-1; for (i=0; i<seq->size; i++) { bi=seq->item[i].u.integer; if (bi!=lbi+1 || !is_equal(a->item+ai+1,b->item+bi)) { /* insert the equality */ if (lbi>=eqstart) {
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(b,eqstart,lbi+1));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ad=append_array(ad,Pike_sp-1); bd=append_array(bd,Pike_sp-1);
9649491998-02-27Fredrik Hübinette (Hubbe)  pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland)  } /* insert the difference */ lai=ai; ai=array_search(a,b->item+bi,ai+1)-1;
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(b,lbi+1,bi));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  bd=append_array(bd, Pike_sp-1);
9649491998-02-27Fredrik Hübinette (Hubbe)  pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland) 
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(a,lai+1,ai+1));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ad=append_array(ad,Pike_sp-1);
9649491998-02-27Fredrik Hübinette (Hubbe)  pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland)  eqstart=bi; } ai++; lbi=bi; } if (lbi>=eqstart) {
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(b,eqstart,lbi+1));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ad=append_array(ad,Pike_sp-1); bd=append_array(bd,Pike_sp-1);
9649491998-02-27Fredrik Hübinette (Hubbe)  pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland)  } if (b->size>bi+1 || a->size>ai+1) {
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(b,lbi+1,b->size));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  bd=append_array(bd, Pike_sp-1);
9649491998-02-27Fredrik Hübinette (Hubbe)  pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland) 
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(a,ai+1,a->size));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ad=append_array(ad,Pike_sp-1);
9649491998-02-27Fredrik Hübinette (Hubbe)  pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland)  } push_array(ad); push_array(bd);
9649491998-02-27Fredrik Hübinette (Hubbe)  return aggregate_array(2);
088e2e1998-02-12Mirar (Pontus Hagland) }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array permute(array in, int number) *! *! Give a specified permutation of an array. *! *! The number of permutations is equal to @code{sizeof(@[in])!@} *! (the factorial of the size of the given array). *! *! @seealso *! @[shuffle()] */
55683e2000-08-28Per Hedbor PMOD_EXPORT void f_permute( INT32 args ) { INT_TYPE q, i=0, n; struct array *a; struct svalue *it; if( args != 2 ) SIMPLE_TOO_FEW_ARGS_ERROR("permute", 2); if( Pike_sp[ -2 ].type != T_ARRAY )
050df72001-01-03Martin Stjernholm  SIMPLE_BAD_ARG_ERROR("permute", 1, "array");
55683e2000-08-28Per Hedbor  if (Pike_sp[ -1 ].type != T_INT)
050df72001-01-03Martin Stjernholm  SIMPLE_BAD_ARG_ERROR("permute", 2, "int");
55683e2000-08-28Per Hedbor  n = Pike_sp[ -1 ].u.integer; a = copy_array( Pike_sp[ -2 ].u.array ); pop_n_elems( args ); q = a->size; it = a->item; while( n && q ) { int x = n % q; n /= q; q--; if( x ) { struct svalue tmp; tmp = it[i]; it[i] = it[i+x]; it[i+x] = tmp; } i++; } push_array( a ); }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array(array(array)) diff(array a, array b) *! *! Calculates which parts of the arrays that are common to both, and *! which parts that are not. *! *! @returns *! Returns an array with two elements, the first is an array of parts in *! array @[a], and the second is an array of parts in array @[b]. *! *! @seealso *! @[diff_compare_table()], @[diff_longset_sequence()], @[String.fuzzymatch()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_diff(INT32 args)
088e2e1998-02-12Mirar (Pontus Hagland) { struct array *seq; struct array *cmptbl; struct array *diff;
f873831998-05-19Henrik Grubbström (Grubba)  int uniq;
088e2e1998-02-12Mirar (Pontus Hagland) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  /* FIXME: Ought to use get_all_args() */
088e2e1998-02-12Mirar (Pontus Hagland)  if (args<2)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("diff", 2);
088e2e1998-02-12Mirar (Pontus Hagland) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-args].type != T_ARRAY)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("diff", 1, "array");
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[1-args].type != T_ARRAY)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("diff", 2, "array");
088e2e1998-02-12Mirar (Pontus Hagland) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  cmptbl = diff_compare_table(Pike_sp[-args].u.array, Pike_sp[1-args].u.array, &uniq);
f873831998-05-19Henrik Grubbström (Grubba) 
bde0ef1998-05-19Henrik Grubbström (Grubba)  push_array(cmptbl); #ifdef ENABLE_DYN_DIFF
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (uniq * 100 > Pike_sp[1-args].u.array->size) {
bde0ef1998-05-19Henrik Grubbström (Grubba) #endif /* ENABLE_DYN_DIFF */
f873831998-05-19Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "diff: Using G-M algorithm, u:%d, s:%d\n",
edf4d02000-07-06Fredrik Hübinette (Hubbe)  uniq, Pike_sp[1-args].u.array->size);
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  seq = diff_longest_sequence(cmptbl, Pike_sp[1-1-args].u.array->size);
bde0ef1998-05-19Henrik Grubbström (Grubba) #ifdef ENABLE_DYN_DIFF
f873831998-05-19Henrik Grubbström (Grubba)  } else { #ifdef DIFF_DEBUG fprintf(stderr, "diff: Using dyn algorithm, u:%d, s:%d\n",
edf4d02000-07-06Fredrik Hübinette (Hubbe)  uniq, Pike_sp[1-args].u.array->size);
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  seq = diff_dyn_longest_sequence(cmptbl, Pike_sp[1-1-args].u.array->size);
bde0ef1998-05-19Henrik Grubbström (Grubba)  } #endif /* ENABLE_DYN_DIFF */ push_array(seq);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  diff=diff_build(Pike_sp[-2-args].u.array,Pike_sp[1-2-args].u.array,seq);
088e2e1998-02-12Mirar (Pontus Hagland)  pop_n_elems(2+args); push_array(diff); }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array(array(int)) diff_compare_table(array a, array b) *! *! Returns an array which maps from index in @[a] to corresponding *! indices in @[b]. *! *! @seealso *! @[diff()], @[diff_longset_sequence()], @[String.fuzzymatch()] */
088e2e1998-02-12Mirar (Pontus Hagland) void f_diff_compare_table(INT32 args) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  struct array *a; struct array *b; struct array *cmptbl;
088e2e1998-02-12Mirar (Pontus Hagland) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  get_all_args("diff_compare_table", args, "%a%a", &a, &b);
088e2e1998-02-12Mirar (Pontus Hagland) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  cmptbl = diff_compare_table(a, b, NULL);
088e2e1998-02-12Mirar (Pontus Hagland) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  pop_n_elems(args); push_array(cmptbl);
088e2e1998-02-12Mirar (Pontus Hagland) }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array(int) diff_longest_sequence(array a, array b) *! *! Gives the longest sequence of indices in @[b] that have corresponding *! values in the same order in @[a]. *! *! @seealso *! @[diff()], @[diff_compare_table()], @[String.fuzzymatch()] */
088e2e1998-02-12Mirar (Pontus Hagland) void f_diff_longest_sequence(INT32 args) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  struct array *a; struct array *b; struct array *seq; struct array *cmptbl;
088e2e1998-02-12Mirar (Pontus Hagland) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  get_all_args("diff_longest_sequence", args, "%a%a", &a, &b);
088e2e1998-02-12Mirar (Pontus Hagland) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  cmptbl = diff_compare_table(a, b, NULL);
088e2e1998-02-12Mirar (Pontus Hagland) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  push_array(cmptbl); seq = diff_longest_sequence(cmptbl, b->size);
bde0ef1998-05-19Henrik Grubbström (Grubba) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  pop_n_elems(args+1); push_array(seq);
088e2e1998-02-12Mirar (Pontus Hagland) }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array(int) diff_dyn_longest_sequence(array a, array b) *! *! Gives the longest sequence of indices in @[b] that have corresponding *! values in the same order in @[a]. *! *! This function performs the same operation as @[diff_longset_sequence()], *! but uses a different algorithm, which in some rare cases might be faster *! (usually it's slower though). *! *! @seealso *! @[diff_longest_sequence()], @[diff()], @[diff_compare_table()], *! @[String.fuzzymatch()] */
f873831998-05-19Henrik Grubbström (Grubba) void f_diff_dyn_longest_sequence(INT32 args) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  struct array *a; struct array *b; struct array *seq; struct array *cmptbl;
f873831998-05-19Henrik Grubbström (Grubba) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  get_all_args("diff_dyn_longest_sequence", args, "%a%a", &a, &b);
f873831998-05-19Henrik Grubbström (Grubba) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  cmptbl=diff_compare_table(a, b, NULL);
f873831998-05-19Henrik Grubbström (Grubba) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  push_array(cmptbl);
f873831998-05-19Henrik Grubbström (Grubba) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  seq = diff_dyn_longest_sequence(cmptbl, b->size); pop_n_elems(args+1); push_array(seq);
f873831998-05-19Henrik Grubbström (Grubba) }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @endmodule */
088e2e1998-02-12Mirar (Pontus Hagland) /**********************************************************************/
c3c7031996-12-04Fredrik Hübinette (Hubbe) static struct callback_list memory_usage_callback; struct callback *add_memory_usage_callback(callback_func call, void *arg, callback_func free_func) { return add_to_callback(&memory_usage_callback, call, arg, free_func); }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl mapping(string:int) _memory_usage() *! *! Check memory usage. *! *! This function is mostly intended for debugging. It delivers a mapping *! with information about how many arrays/mappings/strings etc. there *! are currently allocated and how much memory they use. *! *! @note *! Exactly what this function returns is version dependant. *! *! @seealso *! @[_verify_internals()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__memory_usage(INT32 args)
c3c7031996-12-04Fredrik Hübinette (Hubbe) { INT32 num,size; struct svalue *ss; pop_n_elems(args);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ss=Pike_sp;
c3c7031996-12-04Fredrik Hübinette (Hubbe)  count_memory_in_mappings(&num, &size); push_text("num_mappings"); push_int(num); push_text("mapping_bytes"); push_int(size); count_memory_in_strings(&num, &size); push_text("num_strings"); push_int(num); push_text("string_bytes"); push_int(size); count_memory_in_arrays(&num, &size); push_text("num_arrays"); push_int(num); push_text("array_bytes"); push_int(size); count_memory_in_programs(&num,&size); push_text("num_programs"); push_int(num); push_text("program_bytes"); push_int(size); count_memory_in_multisets(&num, &size); push_text("num_multisets"); push_int(num); push_text("multiset_bytes"); push_int(size); count_memory_in_objects(&num, &size); push_text("num_objects"); push_int(num);
4d58591996-12-04Fredrik Hübinette (Hubbe)  push_text("object_bytes");
c3c7031996-12-04Fredrik Hübinette (Hubbe)  push_int(size); count_memory_in_callbacks(&num, &size); push_text("num_callbacks"); push_int(num); push_text("callback_bytes"); push_int(size); count_memory_in_callables(&num, &size); push_text("num_callables"); push_int(num); push_text("callable_bytes"); push_int(size);
424d9c1999-05-02Fredrik Hübinette (Hubbe)  count_memory_in_pike_frames(&num, &size); push_text("num_frames"); push_int(num); push_text("frame_bytes"); push_int(size);
c3c7031996-12-04Fredrik Hübinette (Hubbe)  call_callback(&memory_usage_callback, (void *)0);
93b7202000-08-14Henrik Grubbström (Grubba)  f_aggregate_mapping(DO_NOT_WARN(Pike_sp - ss));
c3c7031996-12-04Fredrik Hübinette (Hubbe) }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl mixed _next(mixed x) *! *! Find the next object/array/mapping/multiset/program or string. *! *! All objects, arrays, mappings, multisets, programs and strings are *! stored in linked lists inside Pike. This function returns the next *! item on the corresponding list. It is mainly meant for debugging *! the Pike runtime, but can also be used to control memory usage. *! *! @seealso *! @[next_object()], @[_prev()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__next(INT32 args)
8e9fdf1996-12-04Fredrik Hübinette (Hubbe) { struct svalue tmp;
4c3d391999-01-15Fredrik Hübinette (Hubbe) 
7e97c31999-01-21Fredrik Hübinette (Hubbe)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_next: permission denied.\n"));
4c3d391999-01-15Fredrik Hübinette (Hubbe) 
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  if(!args)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("_next", 1);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  pop_n_elems(args-1);
d0d01b1999-03-20Henrik Grubbström (Grubba)  args = 1;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  tmp=Pike_sp[-1];
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  switch(tmp.type) { case T_OBJECT: tmp.u.object=tmp.u.object->next; break; case T_ARRAY: tmp.u.array=tmp.u.array->next; break; case T_MAPPING: tmp.u.mapping=tmp.u.mapping->next; break; case T_MULTISET:tmp.u.multiset=tmp.u.multiset->next; break; case T_PROGRAM: tmp.u.program=tmp.u.program->next; break; case T_STRING: tmp.u.string=tmp.u.string->next; break; default:
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("_next", 1, "object|array|mapping|multiset|program|string");
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  } if(tmp.u.refs) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  assign_svalue(Pike_sp-1,&tmp);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  }else{ pop_stack(); push_int(0); } }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl mixed _prev(mixed x) *! *! Find the previous object/array/mapping/multiset or program. *! *! All objects, arrays, mappings, multisets and programs are *! stored in linked lists inside Pike. This function returns the previous *! item on the corresponding list. It is mainly meant for debugging *! the Pike runtime, but can also be used to control memory usage. *! *! @note *! Unlike @[_next()] this function does not work on strings.
5cb1332001-01-09Henrik Grubbström (Grubba)  *!
7cb4e42001-01-09Henrik Grubbström (Grubba)  *! @seealso *! @[next_object()], @[_prev()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__prev(INT32 args)
8e9fdf1996-12-04Fredrik Hübinette (Hubbe) { struct svalue tmp;
4c3d391999-01-15Fredrik Hübinette (Hubbe) 
7e97c31999-01-21Fredrik Hübinette (Hubbe)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_prev: permission denied.\n"));
4c3d391999-01-15Fredrik Hübinette (Hubbe) 
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  if(!args)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("_prev", 1);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  pop_n_elems(args-1);
d0d01b1999-03-20Henrik Grubbström (Grubba)  args = 1;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  tmp=Pike_sp[-1];
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  switch(tmp.type) { case T_OBJECT: tmp.u.object=tmp.u.object->prev; break; case T_ARRAY: tmp.u.array=tmp.u.array->prev; break; case T_MAPPING: tmp.u.mapping=tmp.u.mapping->prev; break; case T_MULTISET:tmp.u.multiset=tmp.u.multiset->prev; break; case T_PROGRAM: tmp.u.program=tmp.u.program->prev; break; default:
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("_prev", 1, "object|array|mapping|multiset|program");
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  } if(tmp.u.refs) {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  assign_svalue(Pike_sp-1,&tmp);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  }else{ pop_stack(); push_int(0); } }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl int _refs(string|array|mapping|multiset|function|object|program o) *! *! Return the number of references @[o] has. *! *! It is mainly meant for debugging the Pike runtime, but can also be *! used to control memory usage. *! *! @note *! Note that the number of references will always be at least one since *! the value is located on the stack when this function is executed. *! *! @seelaso *! @[_next()], @[_prev()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__refs(INT32 args)
6023ae1997-01-18Fredrik Hübinette (Hubbe) { INT32 i;
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(!args) SIMPLE_TOO_FEW_ARGS_ERROR("_refs", 1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type > MAX_REF_TYPE)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("refs", 1, "array|mapping|multiset|object|" "function|program|string");
6023ae1997-01-18Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  i=Pike_sp[-args].u.refs[0];
6023ae1997-01-18Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(i); }
7371121999-10-19Fredrik Hübinette (Hubbe)  /* This function is for debugging *ONLY* * do not document please. /Hubbe */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__leak(INT32 args)
7371121999-10-19Fredrik Hübinette (Hubbe) { INT32 i; if(!args) SIMPLE_TOO_FEW_ARGS_ERROR("_leak", 1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type > MAX_REF_TYPE)
7371121999-10-19Fredrik Hübinette (Hubbe)  SIMPLE_BAD_ARG_ERROR("_leak", 1, "array|mapping|multiset|object|" "function|program|string");
edf4d02000-07-06Fredrik Hübinette (Hubbe)  add_ref(Pike_sp[-args].u.array); i=Pike_sp[-args].u.refs[0];
7371121999-10-19Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(i); }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl type _typeof(mixed x) *! *! Return the runtime type of @[x]. *! *! @seealso *! @[typeof()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__typeof(INT32 args)
4fbfe21998-12-21Fredrik Hübinette (Hubbe) {
9aadf22000-05-17Henrik Grubbström (Grubba)  struct pike_string *s;
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(!args) SIMPLE_TOO_FEW_ARGS_ERROR("_typeof", 1);
4fbfe21998-12-21Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  s = get_type_of_svalue(Pike_sp-args);
4fbfe21998-12-21Fredrik Hübinette (Hubbe)  pop_n_elems(args);
9aadf22000-05-17Henrik Grubbström (Grubba)  push_string(s);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp[-1].type = T_TYPE;
4fbfe21998-12-21Fredrik Hübinette (Hubbe) }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl void replace_master(object o) *! *! Replace the master object with @[o]. *! *! This will let you control many aspects of how Pike works, but beware that *! @tt{master.pike} may be required to fill certain functions, so it is *! probably a good idea to have your master inherit the original master and *! only re-define certain functions. *! *! @comment *! FIXME: Tell how to inherit the master. *! @endcomment *! *! @seealso *! @[master()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_replace_master(INT32 args)
6023ae1997-01-18Fredrik Hübinette (Hubbe) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("replace_master: permission denied.\n"));
4c3d391999-01-15Fredrik Hübinette (Hubbe) 
6023ae1997-01-18Fredrik Hübinette (Hubbe)  if(!args)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("replace_master", 1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_OBJECT)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("replace_master", 1, "object");
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(!Pike_sp[-args].u.object->prog) bad_arg_error("replace_master", Pike_sp-args, args, 1, "object", Pike_sp-args,
d0d01b1999-03-20Henrik Grubbström (Grubba)  "Called with destructed object.\n");
6023ae1997-01-18Fredrik Hübinette (Hubbe)  free_object(master_object);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  master_object=Pike_sp[-args].u.object;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(master_object);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  free_program(master_program); master_program=master_object->prog;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(master_program);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  pop_n_elems(args); }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl object master(); *! *! Return the current master object. *! *! @seealso *! @[replace_master()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_master(INT32 args)
41e4341997-09-06Henrik Grubbström (Grubba) { pop_n_elems(args);
164e371998-05-13Fredrik Hübinette (Hubbe)  ref_push_object(master());
41e4341997-09-06Henrik Grubbström (Grubba) }
bbc16c2000-08-29Mirar (Pontus Hagland) #ifdef HAVE_SYS_TIME_H
9548a81997-05-07Per Hedbor #include <sys/time.h>
bbc16c2000-08-29Mirar (Pontus Hagland) #endif #ifdef HAVE_GETHRVTIME
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl int gethrvtime() */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_gethrvtime(INT32 args)
9548a81997-05-07Per Hedbor { pop_n_elems(args);
cbbff81999-10-31Henrik Grubbström (Grubba)  push_int64(gethrvtime()/1000);
9548a81997-05-07Per Hedbor }
bbc16c2000-08-29Mirar (Pontus Hagland) #endif
9548a81997-05-07Per Hedbor 
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl int gethrtime() */
bbc16c2000-08-29Mirar (Pontus Hagland) #ifdef HAVE_GETHRTIME
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_gethrtime(INT32 args)
9548a81997-05-07Per Hedbor { pop_n_elems(args);
67a5771998-03-12Per Hedbor  if(args)
cbbff81999-10-31Henrik Grubbström (Grubba)  push_int64(gethrtime());
67a5771998-03-12Per Hedbor  else
cbbff81999-10-31Henrik Grubbström (Grubba)  push_int64(gethrtime()/1000);
9548a81997-05-07Per Hedbor }
69b5a61998-02-10Per Hedbor #else
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_gethrtime(INT32 args)
69b5a61998-02-10Per Hedbor { struct timeval tv; pop_n_elems(args); GETTIMEOFDAY(&tv);
cbbff81999-10-31Henrik Grubbström (Grubba) #ifdef INT64
67a5771998-03-12Per Hedbor  if(args)
cbbff81999-10-31Henrik Grubbström (Grubba)  push_int64((((INT64)tv.tv_sec * 1000000) + tv.tv_usec)*1000);
67a5771998-03-12Per Hedbor  else
b606181999-11-01Mirar (Pontus Hagland)  push_int64(((INT64)tv.tv_sec * 1000000) + tv.tv_usec);
cbbff81999-10-31Henrik Grubbström (Grubba) #else /* !INT64 */ if(args) push_int64(((tv.tv_sec * 1000000) + tv.tv_usec)*1000); else
b606181999-11-01Mirar (Pontus Hagland)  push_int64((tv.tv_sec * 1000000) + tv.tv_usec);
cbbff81999-10-31Henrik Grubbström (Grubba) #endif /* INT64 */
69b5a61998-02-10Per Hedbor }
bbc16c2000-08-29Mirar (Pontus Hagland) #endif /* HAVE_GETHRTIME */
9548a81997-05-07Per Hedbor 
44c89f1997-08-27Henrik Grubbström (Grubba) #ifdef PROFILING
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array(int|mapping(string:array(int))) get_profiling_info(program prog) *! *! Get profiling information. *! *! @returns *! Returns an array with two elements. *! @array *! @elem int num_clones *! The first element is the number of times the program @[prog] has been *! instantiated. *! @elem mapping(string:array(int)) fun_prof_info *! The second element is mapping from function name to an *! array with three elements. *! @array *! @elem int num_calls *! The first element is the number of times the function has been *! called. *! @elem int total_time *! The second element is the total time (in milliseconds) spent *! executing this function, and any functions called from it. *! @elem int self_time *! The third element is the time (in milliseconds) actually spent *! in this function so far. *! @endarray *! @endarray *! *! @note *! This function is only available if the runtime was compiled with *! the option @tt{--with-profiling}. */
44c89f1997-08-27Henrik Grubbström (Grubba) static void f_get_prof_info(INT32 args) {
a2a8801998-03-18Per Hedbor  struct program *prog = 0;
44c89f1997-08-27Henrik Grubbström (Grubba)  int num_functions; int i; if (!args) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("get_profiling_info", 1);
44c89f1997-08-27Henrik Grubbström (Grubba)  }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  prog = program_from_svalue(Pike_sp-args);
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(!prog) SIMPLE_BAD_ARG_ERROR("get_profiling_info", 1, "program|function|object");
a2a8801998-03-18Per Hedbor 
face791999-10-18Henrik Grubbström (Grubba)  /* ({ num_clones, ([ "fun_name":({ num_calls, total_time, self_time }) ]) }) */
44c89f1997-08-27Henrik Grubbström (Grubba) 
5f19a42000-03-08Henrik Grubbström (Grubba)  pop_n_elems(args-1); args = 1;
44c89f1997-08-27Henrik Grubbström (Grubba)  push_int(prog->num_clones);
1dfed21997-11-02Henrik Grubbström (Grubba)  for(num_functions=i=0; i<(int)prog->num_identifiers; i++) {
a2a8801998-03-18Per Hedbor  if (prog->identifiers[i].num_calls) {
44c89f1997-08-27Henrik Grubbström (Grubba)  num_functions++;
face791999-10-18Henrik Grubbström (Grubba)  ref_push_string(prog->identifiers[i].name);
44c89f1997-08-27Henrik Grubbström (Grubba)  push_int(prog->identifiers[i].num_calls);
a2a8801998-03-18Per Hedbor  push_int(prog->identifiers[i].total_time);
6189631998-11-12Fredrik Hübinette (Hubbe)  push_int(prog->identifiers[i].self_time); f_aggregate(3);
44c89f1997-08-27Henrik Grubbström (Grubba)  } } f_aggregate_mapping(num_functions * 2); f_aggregate(2);
5f19a42000-03-08Henrik Grubbström (Grubba)  stack_swap(); pop_stack();
44c89f1997-08-27Henrik Grubbström (Grubba) } #endif /* PROFILING */
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl int(0..1) object_variablep(object o, string var) *! *! Find out if an object identifier is a variable. *! *! This function return @tt{1@} if @[var] exists is a non-static variable *! in @[o], @tt{0@} (zero) otherwise. *! *! @seealso *! @[indices()], @[values()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_object_variablep(INT32 args)
ef5b9e1997-10-07Fredrik Hübinette (Hubbe) { struct object *o; struct pike_string *s; int ret; get_all_args("variablep",args,"%o%S",&o, &s); if(!o->prog)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  bad_arg_error("variablep", Pike_sp-args, args, 1, "object", Pike_sp-args,
d0d01b1999-03-20Henrik Grubbström (Grubba)  "Called on destructed object.\n");
ef5b9e1997-10-07Fredrik Hübinette (Hubbe) 
7cb4e42001-01-09Henrik Grubbström (Grubba)  /* FIXME: Ought to be overloadable, since `[]=() is... */
ef5b9e1997-10-07Fredrik Hübinette (Hubbe)  ret=find_shared_string_identifier(s,o->prog); if(ret!=-1) { ret=IDENTIFIER_IS_VARIABLE(ID_FROM_INT(o->prog, ret)->identifier_flags); }else{ ret=0; } pop_n_elems(args); push_int(!!ret); }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @module Array */ /*! @decl array uniq(array a) *! *! Remove elements that are duplicates. *! *! This function returns an copy of the array <i>a</i> with all duplicate *! values removed. The order of the values is kept in the result. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_uniq_array(INT32 args)
ff8d732000-04-21Fredrik Hübinette (Hubbe) {
652d922000-04-19David Hedbor  struct array *a, *b; struct mapping *m; struct svalue one;
ff8d732000-04-21Fredrik Hübinette (Hubbe)  int i, j=0,size=0;
652d922000-04-19David Hedbor  get_all_args("uniq", args, "%a", &a);
ff8d732000-04-21Fredrik Hübinette (Hubbe)  push_mapping(m = allocate_mapping(a->size)); push_array(b = allocate_array(a->size));
652d922000-04-19David Hedbor  one.type = T_INT; one.u.integer = 1; for(i =0; i< a->size; i++) {
ff8d732000-04-21Fredrik Hübinette (Hubbe)  mapping_insert(m, ITEM(a)+i, &one); if(m_sizeof(m) != size) { size=m_sizeof(m); assign_svalue_no_free(ITEM(b)+ j++, ITEM(a)+i);
652d922000-04-19David Hedbor  } }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; /* keep the ref to 'b' */
ff8d732000-04-21Fredrik Hübinette (Hubbe)  b=resize_array(b, j); pop_n_elems(args-1); /* pop args and the mapping */
652d922000-04-19David Hedbor  push_array(b); }
f7aff61998-04-14Henrik Wallin 
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array(mixed) Array.splice(array(mixed) arr1, array(mixed) arr2, *! array(mixed) ...); *! *! Splice two or more arrays. *! *! This means that the the array becomes an array of the first element *! in the first given array, the first argument in next array and so on *! for all arrays. Then the second elements are added, etc. *! *! @seealso *! @[`/()], @[`*()], @[`+()], @[`-()], @[everynth()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_splice(INT32 args)
f7aff61998-04-14Henrik Wallin { struct array *out;
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  INT32 size=0x7fffffff; INT32 i,j,k;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
f7aff61998-04-14Henrik Wallin  if(args < 0) fatal("Negative args to f_splice()\n"); #endif
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  for(i=0;i<args;i++)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[i-args].type!=T_ARRAY)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("splice", i+1, "array");
f7aff61998-04-14Henrik Wallin  else
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[i-args].u.array->size < size) size=Pike_sp[i-args].u.array->size;
f7aff61998-04-14Henrik Wallin 
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  out=allocate_array(args * size);
f7aff61998-04-14Henrik Wallin  if (!args) { push_array(out); return; }
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  out->type_field=0;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  for(i=-args; i<0; i++) out->type_field|=Pike_sp[i].u.array->type_field;
f7aff61998-04-14Henrik Wallin 
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  for(k=j=0; j<size; j++)
f7aff61998-04-14Henrik Wallin  for(i=-args; i<0; i++)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  assign_svalue_no_free(out->item+(k++), Pike_sp[i].u.array->item+j);
47dd8f1998-04-14Fredrik Hübinette (Hubbe) 
f7aff61998-04-14Henrik Wallin  pop_n_elems(args); push_array(out); return; }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array(mixed) Array.everynth(array(mixed) a, void|int n, *! void|int start) *! *! Return an array with every @[n]:th element of the array @[a]. *! *! If @[n] is zero every other element will be returned. *! *! @seealso *! @[splice()], @[`/()] */
f7aff61998-04-14Henrik Wallin void f_everynth(INT32 args) {
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  INT32 k,n=2;
f7aff61998-04-14Henrik Wallin  INT32 start=0; struct array *a; struct array *ina; INT32 size=0;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
f7aff61998-04-14Henrik Wallin  if(args < 0) fatal("Negative args to f_everynth()\n"); #endif
47dd8f1998-04-14Fredrik Hübinette (Hubbe) 
d0d01b1999-03-20Henrik Grubbström (Grubba)  check_all_args("everynth", args, BIT_ARRAY, BIT_INT | BIT_VOID, BIT_INT | BIT_VOID , 0);
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  switch(args)
f7aff61998-04-14Henrik Wallin  {
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  default: case 3:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  start=Pike_sp[2-args].u.integer;
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(start<0)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  bad_arg_error("everynth", Pike_sp-args, args, 3, "int", Pike_sp+2-args,
d0d01b1999-03-20Henrik Grubbström (Grubba)  "Argument negative.\n");
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  case 2:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  n=Pike_sp[1-args].u.integer;
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(n<1)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  bad_arg_error("everynth", Pike_sp-args, args, 2, "int", Pike_sp+1-args,
d0d01b1999-03-20Henrik Grubbström (Grubba)  "Argument negative.\n");
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  case 1:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ina=Pike_sp[-args].u.array;
f7aff61998-04-14Henrik Wallin  }
47dd8f1998-04-14Fredrik Hübinette (Hubbe) 
f7aff61998-04-14Henrik Wallin  a=allocate_array(((size=ina->size)-start+n-1)/n);
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  for(k=0; start<size; start+=n) assign_svalue_no_free(a->item+(k++), ina->item+start);
f7aff61998-04-14Henrik Wallin  a->type_field=ina->type_field;
32fd451998-07-16David Hedbor  pop_n_elems(args);
f7aff61998-04-14Henrik Wallin  push_array(a); return; }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array(array) transpose(array(array) matrix) */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_transpose(INT32 args)
f7aff61998-04-14Henrik Wallin { struct array *out; struct array *in; struct array *outinner; struct array *ininner; INT32 sizeininner=0,sizein=0; INT32 inner=0;
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  INT32 j,i;
f7aff61998-04-14Henrik Wallin  TYPE_FIELD type=0;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
f7aff61998-04-14Henrik Wallin  if(args < 0) fatal("Negative args to f_transpose()\n"); #endif if (args<1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("transpose", 1);
f7aff61998-04-14Henrik Wallin 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-args].type!=T_ARRAY)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("transpose", 1, "array(array)");
f7aff61998-04-14Henrik Wallin 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  in=Pike_sp[-args].u.array;
f7aff61998-04-14Henrik Wallin  sizein=in->size;
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  if(!sizein)
f7aff61998-04-14Henrik Wallin  { pop_n_elems(args); out=allocate_array(0); push_array(out); return; }
5099861998-07-12Martin Stjernholm  if(in->type_field != BIT_ARRAY)
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  { array_fix_type_field(in);
5099861998-07-12Martin Stjernholm  if(!in->type_field || in->type_field & ~BIT_ARRAY)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("The array given as argument 1 to transpose must contain arrays only.\n");
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  } sizeininner=in->item->u.array->size;
f7aff61998-04-14Henrik Wallin  for(i=1 ; i<sizein; i++)
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  if (sizeininner!=(in->item+i)->u.array->size)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("The array given as argument 1 to transpose must contain arrays of the same size.\n");
f7aff61998-04-14Henrik Wallin  out=allocate_array(sizeininner); for(i=0; i<sizein; i++)
4c3d391999-01-15Fredrik Hübinette (Hubbe)  type|=in->item[i].u.array->type_field;
f7aff61998-04-14Henrik Wallin 
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  for(j=0; j<sizeininner; j++)
f7aff61998-04-14Henrik Wallin  { struct svalue * ett; struct svalue * tva;
47dd8f1998-04-14Fredrik Hübinette (Hubbe) 
f7aff61998-04-14Henrik Wallin  outinner=allocate_array(sizein); ett=outinner->item; tva=in->item; for(i=0; i<sizein; i++)
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  assign_svalue_no_free(ett+i, tva[i].u.array->item+j); outinner->type_field=type;
5ece8d1998-04-14Henrik Wallin  out->item[j].u.array=outinner;
f7aff61998-04-14Henrik Wallin  out->item[j].type=T_ARRAY; }
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  out->type_field=BIT_ARRAY;
f7aff61998-04-14Henrik Wallin  pop_n_elems(args); push_array(out); return; }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @endmodule */
0e88611998-04-16Fredrik Hübinette (Hubbe) #ifdef DEBUG_MALLOC
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl void _reset_dmalloc() */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__reset_dmalloc(INT32 args)
0e88611998-04-16Fredrik Hübinette (Hubbe) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_reset_dmalloc: permission denied.\n"));
0e88611998-04-16Fredrik Hübinette (Hubbe)  pop_n_elems(args); reset_debug_malloc(); }
ec7d6d1999-05-13Fredrik Hübinette (Hubbe) 
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl void _dmalloc_set_name(string filename, int linenumber) */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__dmalloc_set_name(INT32 args)
6657a51999-10-21Fredrik Hübinette (Hubbe) { char *s; INT_TYPE i;
20f7a02000-03-20Fredrik Hübinette (Hubbe)  extern char * dynamic_location(const char *file, int line); extern char * dmalloc_default_location;
6657a51999-10-21Fredrik Hübinette (Hubbe)  if(args) { get_all_args("_dmalloc_set_name", args, "%s%i", &s, &i);
20f7a02000-03-20Fredrik Hübinette (Hubbe)  dmalloc_default_location = dynamic_location(s, i);
6657a51999-10-21Fredrik Hübinette (Hubbe)  }else{ dmalloc_default_location=0; } pop_n_elems(args); }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl void _list_open_fds() */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__list_open_fds(INT32 args)
ec7d6d1999-05-13Fredrik Hübinette (Hubbe) { extern void list_open_fds(void); list_open_fds(); }
0e88611998-04-16Fredrik Hübinette (Hubbe) #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl mapping(string:int) _locate_references(string|array|mapping|multiset|function|object|program o) *! *! This function is mostly intended for debugging. It will search through *! all data structures in Pike looking for @[o] and print the *! locations on stderr. @[o] can be anything but @tt{int@} or *! @tt{float@}. *! *! @note *! This function only exists if the Pike runtime has been compiled *! with RTL debug. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__locate_references(INT32 args)
8af3901998-04-27Fredrik Hübinette (Hubbe) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_locate_references: permission denied.\n"));
8af3901998-04-27Fredrik Hübinette (Hubbe)  if(args)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  locate_references(Pike_sp[-args].u.refs);
8af3901998-04-27Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); }
2eeba91999-03-17Fredrik Hübinette (Hubbe) 
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! mixed _describe(mixed x) */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__describe(INT32 args)
2eeba91999-03-17Fredrik Hübinette (Hubbe) {
b22cfa2000-04-15Henrik Grubbström (Grubba)  struct svalue *s; CHECK_SECURITY_OR_ERROR(SECURITY_BIT_SECURITY, ("_optimizer_debug: permission denied.\n"));
6809042000-04-15Henrik Grubbström (Grubba)  get_all_args("_describe", args, "%*", &s);
b22cfa2000-04-15Henrik Grubbström (Grubba)  debug_describe_svalue(debug_malloc_pass(s)); pop_n_elems(args-1);
2eeba91999-03-17Fredrik Hübinette (Hubbe) }
8af3901998-04-27Fredrik Hübinette (Hubbe) #endif
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array map_array(array arr, function fun, mixed ... args) *! @decl array map_array(array(object) arr, string fun, mixed ... args) *! @decl array map_array(array(function) arr, int(-1..-1) minus_one, *! mixed ... args) *! *! This function is similar to @[map()]. *! *! @note *! This function has been deprecated in favour of @[map()]. *! *! @see_also *! @[map()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_map_array(INT32 args)
f532d81998-09-18Fredrik Hübinette (Hubbe) { ONERROR tmp; INT32 e; struct svalue *fun; struct array *ret,*foo;
2ff5a51998-09-19Henrik Grubbström (Grubba)  if (args < 2)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("map_array", 2);
2ff5a51998-09-19Henrik Grubbström (Grubba) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp[-args].type != T_ARRAY)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("map_array", 1, "array");
f532d81998-09-18Fredrik Hübinette (Hubbe) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  foo=Pike_sp[-args].u.array; fun=Pike_sp-args+1;
f532d81998-09-18Fredrik Hübinette (Hubbe)  ret=allocate_array(foo->size); SET_ONERROR(tmp, do_free_array, ret); for(e=0;e<foo->size;e++) { push_svalue(foo->item+e);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  assign_svalues_no_free(Pike_sp,fun+1,args-2,-1); Pike_sp+=args-2;
f532d81998-09-18Fredrik Hübinette (Hubbe)  apply_svalue(fun,args-1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  ret->item[e]=*(--Pike_sp); dmalloc_touch_svalue(Pike_sp);
f532d81998-09-18Fredrik Hübinette (Hubbe)  } pop_n_elems(args); UNSET_ONERROR(tmp); push_array(ret); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl array map(array arr, function|program|object|array fun, mixed ... extra) *! @decl array map(array arr, multiset|mapping fun) *! @decl array map(array arr, string fun, mixed ... extra) *! @decl array map(array arr, void|zero, mixed ... extra) *! @decl mapping map(mapping|program|function arr, mixed fun, mixed ... extra) *! @decl multiset map(multiset arr, mixed fun, mixed ... extra) *! @decl string map(string arr, mixed fun, mixed ... extra) *! @decl mixed map(object arr, mixed fun, mixewd ... extra) *! *! Map a function over eleemnts. *! *! @section Basic use *! map() loops over all elements in arr and call the *! function fun with the element as first argument, with all "extra" *! arguments following. The result is the same datatype as "arr", but all *! elements is the result from the function call of the corresponding *! element. *! @endsection *! *! @section Advanced use *! There are a wide number of valid combinations of types for the arguments *! @[arr] and @[fun]. *! @mixed @[arr] *! @type array *! @mixed @[fun] *! @type function|program|object|array *! @code{array ret; ret[i]=fun(arr[i],@extra);@} *! @type multiset|mapping *! @code{array ret = rows(fun,arr);@} *! @type string *! @code{array ret = arr[fun](@extra);@} *! @type void|zero *! @code{array ret = arr(@extra);@} *! @endmixed *! @type mapping|program|function *! @code{mapping ret = mkmapping(indices(arr), *! map(values(arr),fun,@extra));@} *! @type multiset *! @code{multiset ret = (multiset)(map(indices(arr),fun,@extra));@} *! @type string *! @code{string ret = (string)map((array)arr,fun,@extra);@} *! @type object *! If @[arr] implements @[_cast()], try casting in turn *! @list *! @item *! @code{map((array)arr,fun,@extra);@} *! @item *! @code{map((mapping)arr,fun,@extra);@} *! @item *! @code{map((multiset)arr,fun,@extra);@} *! @endlist *! If @[arr] implements both @[_sizeof()], and @[`[]()], *! assume @[arr] simulates an array. *! @endmixed *! @endsection *! *! @returns *! Generally the same datatype as given, but with the subtype set to *! the return value of the function; the exception are program and *! function that gives a mapping back *! *! @note *! You may get unexpected errors if you feed the function with *! illegal values; for instance if @[fun] is an array of *! non-callables. *! *! @seealso *! @[filter()], @[enumerate()], @[foreach()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_map(INT32 args)
9abafd1999-07-27Mirar (Pontus Hagland) { struct svalue *mysp; struct array *a,*d,*f; int splice,i,n; if (args<1) SIMPLE_TOO_FEW_ARGS_ERROR("map", 1); else if (args<2) { push_int(0); args++; }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch (Pike_sp[-args].type)
9abafd1999-07-27Mirar (Pontus Hagland)  { case T_ARRAY: break; case T_MAPPING: case T_PROGRAM: case T_FUNCTION: /* mapping ret = mkmapping(indices(arr), map(values(arr),fun,@extra)); */ f_aggregate(args-2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp=Pike_sp;
9abafd1999-07-27Mirar (Pontus Hagland)  splice=mysp[-1].u.array->size; push_svalue(mysp-3); /* arr */ f_values(1); push_svalue(mysp-2); /* fun */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  *Pike_sp=mysp[-1]; /* extra */
9abafd1999-07-27Mirar (Pontus Hagland)  mysp[-1].type=T_INT;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  push_array_items(Pike_sp->u.array);
9abafd1999-07-27Mirar (Pontus Hagland)  f_map(splice+2); /* ... arr fun extra -> ... retval */ stack_pop_n_elems_keep_top(2); /* arr fun extra ret -> arr retval */ stack_swap(); /* retval arr */ f_indices(1); /* retval retind */ stack_swap(); /* retind retval */ f_mkmapping(2); /* ret :-) */ return; case T_MULTISET: /* multiset ret = (multiset)(map(indices(arr),fun,@extra)); */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  push_svalue(Pike_sp-args); /* take indices from arr */ free_svalue(Pike_sp-args-1); /* move it to top of stack */ Pike_sp[-args-1].type=T_INT;
9abafd1999-07-27Mirar (Pontus Hagland)  f_indices(1); /* call f_indices */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; dmalloc_touch_svalue(Pike_sp); Pike_sp[-args]=Pike_sp[0]; /* move it back */
9abafd1999-07-27Mirar (Pontus Hagland)  f_map(args);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; /* allocate_multiset is destructive */ dmalloc_touch_svalue(Pike_sp); push_multiset(allocate_multiset(Pike_sp->u.array));
e1783f2000-08-24Martin Stjernholm  order_multiset(sp[-1].u.multiset);
9abafd1999-07-27Mirar (Pontus Hagland)  return; case T_STRING: /* multiset ret = (string)(map((array)arr,fun,@extra)); */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  push_svalue(Pike_sp-args); /* take indices from arr */ free_svalue(Pike_sp-args-1); /* move it to top of stack */ Pike_sp[-args-1].type=T_INT;
9abafd1999-07-27Mirar (Pontus Hagland)  o_cast(NULL,T_ARRAY); /* cast the string to an array */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; dmalloc_touch_svalue(Pike_sp); Pike_sp[-args]=Pike_sp[0]; /* move it back */
9abafd1999-07-27Mirar (Pontus Hagland)  f_map(args); o_cast(NULL,T_STRING); /* cast the array to a string */ return; case T_OBJECT: /* if arr->cast : try map((array)arr,fun,@extra); try map((mapping)arr,fun,@extra); try map((multiset)arr,fun,@extra); */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp=Pike_sp+3-args;
9abafd1999-07-27Mirar (Pontus Hagland)  push_svalue(mysp-3); push_constant_text("cast"); f_arrow(2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (!IS_ZERO(Pike_sp-1))
9abafd1999-07-27Mirar (Pontus Hagland)  { pop_stack(); push_constant_text("array"); safe_apply(mysp[-3].u.object,"cast",1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-1].type==T_ARRAY)
9abafd1999-07-27Mirar (Pontus Hagland)  { free_svalue(mysp-3);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp[-3]=*(--Pike_sp); dmalloc_touch_svalue(Pike_sp);
9abafd1999-07-27Mirar (Pontus Hagland)  f_map(args); return; } pop_stack(); push_constant_text("mapping"); safe_apply(mysp[-3].u.object,"cast",1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-1].type==T_MAPPING)
9abafd1999-07-27Mirar (Pontus Hagland)  { free_svalue(mysp-3);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp[-3]=*(--Pike_sp); dmalloc_touch_svalue(Pike_sp);
9abafd1999-07-27Mirar (Pontus Hagland)  f_map(args); return; } pop_stack(); push_constant_text("multiset"); safe_apply(mysp[-3].u.object,"cast",1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-1].type==T_MULTISET)
9abafd1999-07-27Mirar (Pontus Hagland)  { free_svalue(mysp-3);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp[-3]=*(--Pike_sp); dmalloc_touch_svalue(Pike_sp);
9abafd1999-07-27Mirar (Pontus Hagland)  f_map(args); return; } pop_stack(); } pop_stack(); /* if arr->_sizeof && arr->`[] array ret; ret[i]=arr[i]; ret=map(ret,fun,@extra); */ /* class myarray { int a0=1,a1=2; int `[](int what) { return ::`[]("a"+what); } int _sizeof() { return 2; } } map(myarray(),lambda(int in){ werror("in=%d\n",in); }); */ push_svalue(mysp-3); push_constant_text("`[]"); f_arrow(2); push_svalue(mysp-3); push_constant_text("_sizeof"); f_arrow(2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (!IS_ZERO(Pike_sp-2)&&!IS_ZERO(Pike_sp-1))
9abafd1999-07-27Mirar (Pontus Hagland)  { f_call_function(1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-1].type!=T_INT)
9abafd1999-07-27Mirar (Pontus Hagland)  SIMPLE_BAD_ARG_ERROR("map", 1, "object sizeof() returning integer");
edf4d02000-07-06Fredrik Hübinette (Hubbe)  n=Pike_sp[-1].u.integer;
9abafd1999-07-27Mirar (Pontus Hagland)  pop_stack(); push_array(d=allocate_array(n)); stack_swap(); for (i=0; i<n; i++) { stack_dup(); /* `[] */ push_int(i); f_call_function(2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  d->item[i]=*(--Pike_sp); dmalloc_touch_svalue(Pike_sp);
9abafd1999-07-27Mirar (Pontus Hagland)  } pop_stack(); free_svalue(mysp-3);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp[-3]=*(--Pike_sp); dmalloc_touch_svalue(Pike_sp);
9abafd1999-07-27Mirar (Pontus Hagland)  f_map(args); return; } pop_stack(); pop_stack(); SIMPLE_BAD_ARG_ERROR("map",1, "object that works in map"); default: SIMPLE_BAD_ARG_ERROR("map",1, "array|mapping|program|function|" "multiset|string|object"); } f_aggregate(args-2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp=Pike_sp;
9abafd1999-07-27Mirar (Pontus Hagland)  splice=mysp[-1].u.array->size; a=mysp[-3].u.array; n=a->size; switch (mysp[-2].type) { case T_FUNCTION: case T_PROGRAM: case T_OBJECT: case T_ARRAY: /* ret[i]=fun(arr[i],@extra); */ push_array(d=allocate_array(n));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  d=Pike_sp[-1].u.array;
283ec72000-04-15Fredrik Hübinette (Hubbe)  if(mysp[-2].type == T_FUNCTION && mysp[-2].subtype == FUNCTION_BUILTIN)
9abafd1999-07-27Mirar (Pontus Hagland)  {
283ec72000-04-15Fredrik Hübinette (Hubbe)  c_fun fun=mysp[-2].u.efun->function;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  struct svalue *spbase=Pike_sp;
283ec72000-04-15Fredrik Hübinette (Hubbe)  if(splice) { for (i=0; i<n; i++) { push_svalue(a->item+i); add_ref_svalue(mysp-1); push_array_items(mysp[-1].u.array); (* fun)(1+splice);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp>spbase)
283ec72000-04-15Fredrik Hübinette (Hubbe)  {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  dmalloc_touch_svalue(Pike_sp-1); d->item[i]=*--Pike_sp; pop_n_elems(Pike_sp-spbase);
283ec72000-04-15Fredrik Hübinette (Hubbe)  } } }else{ for (i=0; i<n; i++) { push_svalue(a->item+i); (* fun)(1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(Pike_sp>spbase)
283ec72000-04-15Fredrik Hübinette (Hubbe)  {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  dmalloc_touch_svalue(Pike_sp-1); d->item[i]=*--Pike_sp; pop_n_elems(Pike_sp-spbase);
283ec72000-04-15Fredrik Hübinette (Hubbe)  } } } }else{ for (i=0; i<n; i++) { push_svalue(a->item+i); if (splice) {
9abafd1999-07-27Mirar (Pontus Hagland)  add_ref_svalue(mysp-1); push_array_items(mysp[-1].u.array); apply_svalue(mysp-2,1+splice);
283ec72000-04-15Fredrik Hübinette (Hubbe)  } else {
9abafd1999-07-27Mirar (Pontus Hagland)  apply_svalue(mysp-2,1);
283ec72000-04-15Fredrik Hübinette (Hubbe)  }
edf4d02000-07-06Fredrik Hübinette (Hubbe)  dmalloc_touch_svalue(Pike_sp-1); d->item[i]=*--Pike_sp;
283ec72000-04-15Fredrik Hübinette (Hubbe)  }
9abafd1999-07-27Mirar (Pontus Hagland)  } stack_pop_n_elems_keep_top(3); /* fun arr extra d -> d */ return; case T_MAPPING: case T_MULTISET: /* ret[i]=fun[arr[i]]; */ pop_stack(); stack_swap(); f_rows(2); return; case T_STRING: /* ret[i]=arr[i][fun](@extra); */ push_array(d=allocate_array(n));
edf4d02000-07-06Fredrik Hübinette (Hubbe)  d=Pike_sp[-1].u.array;
9abafd1999-07-27Mirar (Pontus Hagland)  for (i=0; i<n; i++) { push_svalue(a->item+i); push_svalue(mysp-2); f_arrow(2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if(IS_ZERO(Pike_sp-1))
e255531999-08-19Fredrik Hübinette (Hubbe)  { pop_stack(); continue; }
9abafd1999-07-27Mirar (Pontus Hagland)  add_ref_svalue(mysp-1); push_array_items(mysp[-1].u.array); f_call_function(splice+1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  d->item[i]=*--Pike_sp; dmalloc_touch_svalue(Pike_sp);
9abafd1999-07-27Mirar (Pontus Hagland)  } stack_pop_n_elems_keep_top(3); /* fun arr extra d -> d */ return; case T_INT: if (mysp[-2].u.integer==0) { /* ret=arr(@extra); */ stack_swap(); /* arr fun extra -> arr extra fun */ pop_stack(); /* arr extra */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; dmalloc_touch_svalue(Pike_sp); push_array_items(Pike_sp->u.array);
9abafd1999-07-27Mirar (Pontus Hagland)  f_call_function(1+splice);
114fe51999-08-12Martin Stjernholm  return;
9abafd1999-07-27Mirar (Pontus Hagland)  } /* no break here */ default: SIMPLE_BAD_ARG_ERROR("map",2, "function|program|object|" "string|int(0)|multiset"); } }
7cb4e42001-01-09Henrik Grubbström (Grubba) /*! @decl array filter(array arr, function fun, mixed ...extra) *! @decl mixed filter(mixed arr, void|mixed fun, void|mixed ...extra) *! *! Map a function over elements and filters. *! *! Calls the given function @[fun] for all elements in @[arr], and keeps the *! elements in @[arr] that resulted in a non-zero value from the function. *! *! @mixed @[arr] *! @type array *! If @[fun] is an array: *! @code{for (i=0; i<sizeof(@[arr]); i++) { *! if (fun[i]) res += ({ @[arr][i]}); *! @} *! otherwise: *! @code{keep = map(@[arr], @[fun], @@@[extra]); *! for (i=0; i < sizeof(@[arr]); i++) { *! if (keep[i]) res += ({ @[arr][i]}); *! @} *! @type multiset *! @code{(multiset)filter((array)@[arr], @[fun], @@@[extra])@} *! @type mapping|program|function *! @code{ind = indices(@[arr]); *! val = values(@[arr]); *! keep = map(val, @[fun], @@@[extra]); *! for (i=0; i<sizeof(keep); i++) *! if (keep[i]) res[ind[i]] = val[i]; *! @} *! @type string *! @code{(string)filter((array)@[arr], @[fun], @@@[extra])@} *! @type object *! if @code{@[arr]->cast@}, try in turn: *! @code{filter((array)@[arr], @[fun], @@@[extra])@} *! @code{filter((mapping)@[arr], @[fun], @@@[extra])@} *! @code{filter((multiset)@[arr], @[fun], @@@[extra])@} *! @endmixed *! *! @returns *! Returns the same datatype as given, the exceptions are program and *! function that give a mapping back. *! *! @seealso *! @[map()], @[foreach()] */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_filter(INT32 args)
6279131999-07-27Mirar (Pontus Hagland) { int n,i,m,k; struct array *a,*y,*f; struct svalue *mysp; if (args<1) SIMPLE_TOO_FEW_ARGS_ERROR("filter", 1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  switch (Pike_sp[-args].type)
6279131999-07-27Mirar (Pontus Hagland)  { case T_ARRAY:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (args >= 2 && Pike_sp[1-args].type == T_ARRAY) { if (Pike_sp[1-args].u.array->size != Pike_sp[-args].u.array->size)
114fe51999-08-12Martin Stjernholm  SIMPLE_BAD_ARG_ERROR("filter", 2, "array of same size as the first"); pop_n_elems(args-2); } else {
edf4d02000-07-06Fredrik Hübinette (Hubbe)  MEMMOVE(Pike_sp-args+1,Pike_sp-args,args*sizeof(*Pike_sp)); dmalloc_touch_svalue(Pike_sp); Pike_sp++; add_ref_svalue(Pike_sp-args);
114fe51999-08-12Martin Stjernholm  f_map(args); }
6279131999-07-27Mirar (Pontus Hagland) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  f=Pike_sp[-1].u.array; a=Pike_sp[-2].u.array;
6279131999-07-27Mirar (Pontus Hagland)  n=a->size; for (k=m=i=0; i<n; i++) if (!IS_ZERO(f->item+i)) { push_svalue(a->item+i); if (m++>32) {
5665ab1999-07-28Henrik Grubbström (Grubba)  f_aggregate(m); m=0; if (++k>32) { f_add(k); k=1; }
6279131999-07-27Mirar (Pontus Hagland)  } }
5665ab1999-07-28Henrik Grubbström (Grubba)  if (m || !k) { f_aggregate(m); k++; } if (k > 1) f_add(k);
6279131999-07-27Mirar (Pontus Hagland)  stack_pop_n_elems_keep_top(2); return; case T_MAPPING: case T_PROGRAM: case T_FUNCTION: /* mapping ret = mkmapping(indices(arr), map(values(arr),fun,@extra)); */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  MEMMOVE(Pike_sp-args+2,Pike_sp-args,args*sizeof(*Pike_sp)); Pike_sp+=2; Pike_sp[-args-2].type=T_INT; Pike_sp[-args-1].type=T_INT;
6279131999-07-27Mirar (Pontus Hagland) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  push_svalue(Pike_sp-args);
6279131999-07-27Mirar (Pontus Hagland)  f_indices(1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; Pike_sp[-args-2]=*Pike_sp; dmalloc_touch_svalue(Pike_sp); push_svalue(Pike_sp-args);
6279131999-07-27Mirar (Pontus Hagland)  f_values(1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; Pike_sp[-args-1]=*Pike_sp; dmalloc_touch_svalue(Pike_sp);
6279131999-07-27Mirar (Pontus Hagland) 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  assign_svalue(Pike_sp-args,Pike_sp-args-1); /* loop values only */
6279131999-07-27Mirar (Pontus Hagland)  f_map(args);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  y=Pike_sp[-3].u.array; a=Pike_sp[-2].u.array; f=Pike_sp[-1].u.array;
6279131999-07-27Mirar (Pontus Hagland)  n=a->size; for (m=i=0; i<n; i++) if (!IS_ZERO(f->item+i)) m++; push_mapping(allocate_mapping(MAXIMUM(m,4))); for (i=0; i<n; i++) if (!IS_ZERO(f->item+i))
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mapping_insert(Pike_sp[-1].u.mapping,y->item+i,a->item+i);
6279131999-07-27Mirar (Pontus Hagland)  stack_pop_n_elems_keep_top(3); return; case T_MULTISET:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  push_svalue(Pike_sp-args); /* take indices from arr */ free_svalue(Pike_sp-args-1); /* move it to top of stack */ Pike_sp[-args-1].type=T_INT;
6279131999-07-27Mirar (Pontus Hagland)  f_indices(1); /* call f_indices */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; dmalloc_touch_svalue(Pike_sp); Pike_sp[-args]=Pike_sp[0]; /* move it back */
6279131999-07-27Mirar (Pontus Hagland)  f_filter(args);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; /* allocate_multiset is destructive */ dmalloc_touch_svalue(Pike_sp); push_multiset(allocate_multiset(Pike_sp->u.array));
e1783f2000-08-24Martin Stjernholm  order_multiset(sp[-1].u.multiset);
6279131999-07-27Mirar (Pontus Hagland)  return; case T_STRING:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  push_svalue(Pike_sp-args); /* take indices from arr */ free_svalue(Pike_sp-args-1); /* move it to top of stack */ Pike_sp[-args-1].type=T_INT;
6279131999-07-27Mirar (Pontus Hagland)  o_cast(NULL,T_ARRAY); /* cast the string to an array */
edf4d02000-07-06Fredrik Hübinette (Hubbe)  Pike_sp--; dmalloc_touch_svalue(Pike_sp); Pike_sp[-args]=Pike_sp[0]; /* move it back */
6279131999-07-27Mirar (Pontus Hagland)  f_filter(args); o_cast(NULL,T_STRING); /* cast the array to a string */ return; case T_OBJECT:
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp=Pike_sp+3-args;
6279131999-07-27Mirar (Pontus Hagland)  push_svalue(mysp-3); push_constant_text("cast"); f_arrow(2);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (!IS_ZERO(Pike_sp-1))
6279131999-07-27Mirar (Pontus Hagland)  { pop_stack(); push_constant_text("array"); safe_apply(mysp[-3].u.object,"cast",1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-1].type==T_ARRAY)
6279131999-07-27Mirar (Pontus Hagland)  { free_svalue(mysp-3);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp[-3]=*(--Pike_sp); dmalloc_touch_svalue(Pike_sp);
6279131999-07-27Mirar (Pontus Hagland)  f_filter(args); return; } pop_stack(); push_constant_text("mapping"); safe_apply(mysp[-3].u.object,"cast",1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-1].type==T_MAPPING)
6279131999-07-27Mirar (Pontus Hagland)  { free_svalue(mysp-3);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp[-3]=*(--Pike_sp); dmalloc_touch_svalue(Pike_sp);
6279131999-07-27Mirar (Pontus Hagland)  f_filter(args); return; } pop_stack(); push_constant_text("multiset"); safe_apply(mysp[-3].u.object,"cast",1);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  if (Pike_sp[-1].type==T_MULTISET)
6279131999-07-27Mirar (Pontus Hagland)  { free_svalue(mysp-3);
edf4d02000-07-06Fredrik Hübinette (Hubbe)  mysp[-3]=*(--Pike_sp); dmalloc_touch_svalue(Pike_sp);
6279131999-07-27Mirar (Pontus Hagland)  f_filter(args); return; } pop_stack(); } pop_stack(); SIMPLE_BAD_ARG_ERROR("filter",1, "...|object that can be cast to array, multiset or mapping"); default: SIMPLE_BAD_ARG_ERROR("filter",1, "array|mapping|program|function|" "multiset|string|object"); } }
3a58ed2000-04-08Henrik Grubbström (Grubba) /* map(), map_array() and filter() inherit sideeffects from their * second argument. */ static node *fix_map_node_info(node *n) { int argno; node **cb_;
b22b1e2000-04-08Henrik Grubbström (Grubba)  int node_info = OPT_SIDE_EFFECT; /* Assume worst case. */
3a58ed2000-04-08Henrik Grubbström (Grubba)  /* Note: argument 2 has argno 1. */