e576bb2002-10-11Martin Nilsson /* || This file is part of Pike. For copyright information see COPYRIGHT. || Pike is distributed under GPL, LGPL and MPL. See the file COPYING || for more information.
38cb402010-03-30Peter Bortas || $Id: builtin_functions.c,v 1.699 2010/03/30 11:54:56 peter Exp $
e576bb2002-10-11Martin Nilsson */
aedfb12002-10-09Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "global.h" #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"
66bcf02002-12-07Henrik Grubbström (Grubba) #include "pike_rusage.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #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"
37775c2004-04-06Martin Nilsson #include "pike_security.h"
c1073a1999-05-11Mirar (Pontus Hagland) #include "builtin_functions.h"
39ac731999-10-20Fredrik Noring #include "bignum.h"
629c5e2001-08-31Martin Stjernholm #include "peep.h"
0811472001-07-02Fredrik Hübinette (Hubbe) #include "docode.h" #include "lex.h"
a63b362003-11-07Martin Stjernholm #include "pike_float.h"
e021fe2008-04-14Henrik Grubbström (Grubba) #include "pike_compiler.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) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function checks if the values @[a] and @[b] are equal.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! For all types but arrays, multisets and mappings, this operation is
f79bd82003-04-01Martin Nilsson  *! the same as doing @expr{@[a] == @[b]@}.
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[copy_value()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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)
7c9e8a2003-01-04Martin Nilsson  SIMPLE_TOO_FEW_ARGS_ERROR("equal", 2);
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)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Construct an array with the arguments as indices.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function could be written in Pike as:
f79bd82003-04-01Martin Nilsson  *! @code *! array aggregate(mixed ... elems) { return elems; } *! @endcode
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! Arrays are dynamically allocated there is no need to declare them
f79bd82003-04-01Martin Nilsson  *! like @expr{int a[10]=allocate(10);@} (and it isn't possible either) like *! in C, just @expr{array(int) a=allocate(10);@} will do.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[sizeof()], @[arrayp()], @[allocate()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void debug_f_aggregate(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a;
99946c1996-02-17Fredrik Hübinette (Hubbe)  a=aggregate_array(args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  push_array(a); /* beware, macro */ }
faafc52005-03-16Henrik Grubbström (Grubba) static node *optimize_f_aggregate(node *n) { /* Split long argument lists into multiple function calls. * * aggregate(...) ==> `+(aggregate(...arg32), aggregate(arg33...), ...) * * Also removes splices. * * Note: We assume that the argument list is in left-recursive form. */ node *args = CDR(n); node *new_args = NULL; node *add_args = NULL; int count; if (!args) return NULL; args->parent = NULL; for (count = 0; args->token == F_ARG_LIST; args = CAR(args)) { if (CDR(args) && CDR(args)->token == F_PUSH_ARRAY) { /* Splices have a weight of 16. */ count += 16; } else { count++; } if (!CAR(args)) break; CAR(args)->parent = args; } if (args->token == F_PUSH_ARRAY) { /* Last argument is a splice */ count += 16; } else if (args->token != F_ARG_LIST) { count++; } /* Ignore cases with 32 or less arguments. */ if (count <= 32) { CDR(n)->parent = n; return NULL; } /* * Perform the actual rewrite. * * Start with the last arg, and work towards the first. */ count = 0; if (args->token != F_ARG_LIST) { if (args->token == F_PUSH_ARRAY) { /* Splice operator. */ add_args = copy_node(CAR(args)); } else { new_args = copy_node(args); count = 1; } args = args->parent; } for(; args; args = args->parent) {
594f162007-01-15Henrik Grubbström (Grubba)  if (!CDR(args)) continue;
faafc52005-03-16Henrik Grubbström (Grubba)  if (CDR(args)->token == F_PUSH_ARRAY) { if (count) { add_args = mknode(F_ARG_LIST, add_args, mkapplynode(copy_node(CAR(n)), new_args)); new_args = NULL; count = 0; } add_args = mknode(F_ARG_LIST, add_args, copy_node(CADR(args))); } else { new_args = mknode(F_ARG_LIST, new_args, copy_node(CDR(args))); count++; if (count > 31) { add_args = mknode(F_ARG_LIST, add_args, mkapplynode(copy_node(CAR(n)), new_args)); new_args = NULL; count = 0; } } } if (count) { add_args = mknode(F_ARG_LIST, add_args, mkapplynode(copy_node(CAR(n)), new_args)); new_args = NULL; count = 0; } CDR(n)->parent = n; return mkefuncallnode("`+", add_args); }
0811472001-07-02Fredrik Hübinette (Hubbe) 
a562792008-06-29Henrik Grubbström (Grubba) /*! @decl __deprecated__ int hash_7_4(string s) *! @decl __deprecated__ int hash_7_4(string s, int max) *! *! @deprecated 7.4::hash *! *! @seealso *! @[7.4::hash()] */ /*! @decl __deprecated__ int hash_7_0(string s) *! @decl __deprecated__ int hash_7_0(string s, int max) *! *! @deprecated 7.0::hash *! *! @seealso *! @[7.0::hash()] */
e3f6f92008-06-29Henrik Grubbström (Grubba) /*! @namespace 7.4:: */ /*! @decl int hash(string s) *! @decl int hash(string s, int max)
5d98c42003-03-02Henrik Grubbström (Grubba)  *!
5ad0962003-11-10Martin Stjernholm  *! Return an integer derived from the string @[s]. The same string *! will always hash to the same value, also between processes. *! *! If @[max] is given, the result will be >= 0 and < @[max], *! otherwise the result will be >= 0 and <= 0x7fffffff.
5d98c42003-03-02Henrik Grubbström (Grubba)  *! *! @note *! This function is provided for backward compatibility reasons. *!
5ad0962003-11-10Martin Stjernholm  *! This function is byte-order dependant for wide strings.
5d98c42003-03-02Henrik Grubbström (Grubba)  *! *! @seealso
e3f6f92008-06-29Henrik Grubbström (Grubba)  *! @[hash()], @[7.0::hash()]
5d98c42003-03-02Henrik Grubbström (Grubba)  */ static void f_hash_7_4(INT32 args) { size_t i = 0; struct pike_string *s = Pike_sp[-args].u.string; if(!args)
e3f6f92008-06-29Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("7.4::hash",1);
5d98c42003-03-02Henrik Grubbström (Grubba)  if(Pike_sp[-args].type != T_STRING)
e3f6f92008-06-29Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("7.4::hash", 1, "string");
5d98c42003-03-02Henrik Grubbström (Grubba)  i = simple_hashmem((unsigned char *)s->str, s->len<<s->size_shift, 100<<s->size_shift); if(args > 1) { if(Pike_sp[1-args].type != T_INT)
e3f6f92008-06-29Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("7.4::hash",2,"int");
5d98c42003-03-02Henrik Grubbström (Grubba)  if(!Pike_sp[1-args].u.integer)
e3f6f92008-06-29Henrik Grubbström (Grubba)  PIKE_ERROR("7.4::hash", "Modulo by zero.\n", Pike_sp, args);
5d98c42003-03-02Henrik Grubbström (Grubba)  i%=(unsigned INT32)Pike_sp[1-args].u.integer; } pop_n_elems(args); push_int64(i); }
e3f6f92008-06-29Henrik Grubbström (Grubba) /*! @endnamespace */ /*! @namespace 7.0:: */ /*! @decl int hash(string s) *! @decl int hash(string s, int max)
ce4d672001-01-31Henrik Grubbström (Grubba)  *!
5ad0962003-11-10Martin Stjernholm  *! Return an integer derived from the string @[s]. The same string *! always hashes to the same value, also between processes. *! *! If @[max] is given, the result will be >= 0 and < @[max], *! otherwise the result will be >= 0 and <= 0x7fffffff.
ce4d672001-01-31Henrik Grubbström (Grubba)  *! *! @note *! This function is provided for backward compatibility reasons. *!
5d98c42003-03-02Henrik Grubbström (Grubba)  *! This function is not NUL-safe, and is byte-order dependant. *!
ce4d672001-01-31Henrik Grubbström (Grubba)  *! @seealso
e3f6f92008-06-29Henrik Grubbström (Grubba)  *! @[hash()], @[7.4::hash()]
ce4d672001-01-31Henrik Grubbström (Grubba)  */
5d98c42003-03-02Henrik Grubbström (Grubba) static void f_hash_7_0( INT32 args )
348cff2000-12-11Per Hedbor { struct pike_string *s = Pike_sp[-args].u.string; unsigned int i; if(!args)
e3f6f92008-06-29Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("7.0::hash",1);
348cff2000-12-11Per Hedbor  if(Pike_sp[-args].type != T_STRING)
e3f6f92008-06-29Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("7.0::hash", 1, "string");
348cff2000-12-11Per Hedbor  if( s->size_shift ) {
5d98c42003-03-02Henrik Grubbström (Grubba)  f_hash_7_4( args );
348cff2000-12-11Per Hedbor  return; }
986b522001-03-17Henrik Grubbström (Grubba)  i = DO_NOT_WARN((unsigned int)hashstr( (unsigned char *)s->str, MINIMUM(100,s->len)));
348cff2000-12-11Per Hedbor  if(args > 1) { if(Pike_sp[1-args].type != T_INT)
e3f6f92008-06-29Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("7.0::hash",2,"int");
348cff2000-12-11Per Hedbor  if(!Pike_sp[1-args].u.integer)
e3f6f92008-06-29Henrik Grubbström (Grubba)  PIKE_ERROR("7.0::hash", "Modulo by zero.\n", Pike_sp, args);
348cff2000-12-11Per Hedbor  i%=(unsigned INT32)Pike_sp[1-args].u.integer; } pop_n_elems(args); push_int( i ); }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
e3f6f92008-06-29Henrik Grubbström (Grubba) /*! @endnamespace */
ce4d672001-01-31Henrik Grubbström (Grubba) /*! @decl int hash(string s) *! @decl int hash(string s, int max) *!
5ad0962003-11-10Martin Stjernholm  *! Return an integer derived from the string @[s]. The same string *! always hashes to the same value, also between processes, *! architectures, and Pike versions (see compatibility notes below, *! though). *! *! If @[max] is given, the result will be >= 0 and < @[max], *! otherwise the result will be >= 0 and <= 0x7fffffff.
ce4d672001-01-31Henrik Grubbström (Grubba)  *! *! @note
5d98c42003-03-02Henrik Grubbström (Grubba)  *! The hash algorithm was changed in Pike 7.5. If you want a hash
e3f6f92008-06-29Henrik Grubbström (Grubba)  *! that is compatible with Pike 7.4 and earlier, use @[7.4::hash()].
5ad0962003-11-10Martin Stjernholm  *! The difference only affects wide strings.
5d98c42003-03-02Henrik Grubbström (Grubba)  *! *! The hash algorithm was also changed in Pike 7.1. If you want a hash
e3f6f92008-06-29Henrik Grubbström (Grubba)  *! that is compatible with Pike 7.0 and earlier, use @[7.0::hash()].
ce4d672001-01-31Henrik Grubbström (Grubba)  *! *! @seealso
e3f6f92008-06-29Henrik Grubbström (Grubba)  *! @[7.0::hash()], @[7.4::hash()], @[hash_value]
ce4d672001-01-31Henrik Grubbström (Grubba)  */
5d98c42003-03-02Henrik Grubbström (Grubba) PMOD_EXPORT void f_hash(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
cb787a2000-08-24Henrik Grubbström (Grubba)  size_t i = 0;
5d98c42003-03-02Henrik Grubbström (Grubba)  struct pike_string *s;
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) 
5d98c42003-03-02Henrik Grubbström (Grubba)  s = Pike_sp[-args].u.string; switch(s->size_shift) { case 0: i = simple_hashmem(STR0(s), s->len, 100); break; case 1: i = simple_hashmem1(STR1(s), s->len, 100); break; case 2: i = simple_hashmem2(STR2(s), s->len, 100); break;
c6b6042008-05-03Martin Nilsson #ifdef PIKE_DEBUG
5d98c42003-03-02Henrik Grubbström (Grubba)  default: Pike_fatal("hash(): Unsupported string shift: %d\n", s->size_shift); break;
c6b6042008-05-03Martin Nilsson #endif
5d98c42003-03-02Henrik Grubbström (Grubba)  }
98d8e72000-12-10Per Hedbor 
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) 
c5ab042004-05-13Martin Nilsson  if(Pike_sp[1-args].u.integer <= 0) PIKE_ERROR("hash", "Modulo < 1.\n", Pike_sp, args);
5d98c42003-03-02Henrik Grubbström (Grubba) 
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) }
5ad0962003-11-10Martin Stjernholm /*! @decl int hash_value (mixed value) *! *! Return a hash value for the argument. It's an integer in the *! native integer range. *! *! The hash will be the same for the same value in the running *! process only (the memory address is typically used as the basis *! for the hash value). *! *! If the value is an object with an @[lfun::__hash], that function *! is called and its result is returned. *! *! @note *! This is the hashing method used by mappings. *! *! @seealso *! @[hash] */ void f_hash_value(INT32 args) { unsigned INT32 h; if(!args) SIMPLE_TOO_FEW_ARGS_ERROR("hash_value",1); h = hash_svalue (Pike_sp - args); pop_n_elems (args); push_int (h); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl mixed copy_value(mixed value) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Copy a value recursively.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! If the result value is changed destructively (only possible for *! multisets, arrays and mappings) the copied value will not be changed.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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 @[`==()]).
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[equal()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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);
c2464e2009-08-26Henrik Grubbström (Grubba)  push_undefined(); /* Placeholder */
cada522009-08-26Martin Stjernholm  copy_svalues_recursively_no_free(Pike_sp-1,Pike_sp-2,1,0); free_svalue(Pike_sp-2); move_svalue (Pike_sp - 2, Pike_sp - 1); Pike_sp--;
edf4d02000-07-06Fredrik Hübinette (Hubbe)  dmalloc_touch_svalue(Pike_sp-1);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
94d9921999-03-20Henrik Grubbström (Grubba) struct case_info {
9776dd2001-06-21Henrik Grubbström (Grubba)  INT32 low; /* low end of range. */
8fe0e42005-05-08Martin Nilsson  INT16 mode; INT16 data;
94d9921999-03-20Henrik Grubbström (Grubba) };
002bd52008-05-29Martin Nilsson #define CIM_NONE 0 /* Case-less */ #define CIM_UPPERDELTA 1 /* Upper-case, delta to lower-case in data */ #define CIM_LOWERDELTA 2 /* Lower-case, -delta to upper-case in data */ #define CIM_CASEBIT 3 /* Some case, case mask in data */ #define CIM_CASEBITOFF 4 /* Same as above, but also offset by data */ #define CIM_LONGUPPERDELTA 5 /* Upper-case, delta + 0x7fff. */ #define CIM_LONGLOWERDELTA 6 /* Lower-case, delta + 0x7fff. */
94d9921999-03-20Henrik Grubbström (Grubba) 
0cb4152000-07-19Andreas Lange static const struct case_info case_info[] = {
94d9921999-03-20Henrik Grubbström (Grubba) #include "case_info.h"
9776dd2001-06-21Henrik Grubbström (Grubba)  { 0x7fffffff, CIM_NONE, 0x0000, }, /* End sentinel. */
94d9921999-03-20Henrik Grubbström (Grubba) };
9776dd2001-06-21Henrik Grubbström (Grubba) static struct case_info *find_ci(INT32 c)
94d9921999-03-20Henrik Grubbström (Grubba) { 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);
9776dd2001-06-21Henrik Grubbström (Grubba)  if ((c < 0) || (c > 0xeffff)) { /* Negative, or plane 15 and above. */
94d9921999-03-20Henrik Grubbström (Grubba)  return NULL;
9776dd2001-06-21Henrik Grubbström (Grubba)  }
94d9921999-03-20Henrik Grubbström (Grubba)  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) }
9776dd2001-06-21Henrik Grubbström (Grubba) static struct case_info *find_ci_shift0(INT32 c)
480bf02000-07-27Andreas Lange { static struct case_info *cache = NULL; struct case_info *ci = cache; int lo = 0; int hi = CASE_INFO_SHIFT0_HIGH;
9776dd2001-06-21Henrik Grubbström (Grubba)  if ((c < 0) || (c > 0xefffff)) { /* Negative, or plane 15 and above. */
480bf02000-07-27Andreas Lange  return NULL;
9776dd2001-06-21Henrik Grubbström (Grubba)  }
480bf02000-07-27Andreas Lange  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 {\
9776dd2001-06-21Henrik Grubbström (Grubba)  INT32 c = C; \
002bd52008-05-29Martin Nilsson  if(c<0xb5){if(c >= 'A' && c <= 'Z' ) C=c+0x20; } \ /*else if(c==0xa77d) C=0x1d79;*/ else { \
3325952004-04-13Jonas Wallden  struct case_info *ci = find_ci(c); \
94d9921999-03-20Henrik Grubbström (Grubba)  if (ci) { \ switch(ci->mode) { \
002bd52008-05-29Martin Nilsson  case CIM_NONE: case CIM_LOWERDELTA: case CIM_LONGLOWERDELTA: break; \
164d671999-03-20Henrik Grubbström (Grubba)  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; \
002bd52008-05-29Martin Nilsson  case CIM_LONGUPPERDELTA: \ C = c + ci->data + ( ci->data>0 ? 0x7fff : -0x8000 ); break; \
c6b6042008-05-03Martin Nilsson  DO_IF_DEBUG( default: Pike_fatal("lower_case(): Unknown case_info mode: %d\n", ci->mode); ) \
94d9921999-03-20Henrik Grubbström (Grubba)  } \
bd662f2004-04-12Per Hedbor  }} \
94d9921999-03-20Henrik Grubbström (Grubba)  } while(0)
480bf02000-07-27Andreas Lange #define DO_LOWER_CASE_SHIFT0(C) do {\
9776dd2001-06-21Henrik Grubbström (Grubba)  INT32 c = C; \
03c75f2004-10-14Martin Nilsson  if(c<0xb5){if(c >= 'A' && c <= 'Z' ) C=c+0x20;}else {\
480bf02000-07-27Andreas Lange  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; \
c6b6042008-05-03Martin Nilsson  DO_IF_DEBUG( default: Pike_fatal("lower_case(): Unknown case_info mode: %d\n", ci->mode); ) \
480bf02000-07-27Andreas Lange  } \
bd662f2004-04-12Per Hedbor  }} \
480bf02000-07-27Andreas Lange  } while(0)
94d9921999-03-20Henrik Grubbström (Grubba) #define DO_UPPER_CASE(C) do {\
9776dd2001-06-21Henrik Grubbström (Grubba)  INT32 c = C; \
002bd52008-05-29Martin Nilsson  if(c<0xb5){if(c >= 'a' && c <= 'z' ) C=c-0x20; } \ /*else if(c==0x1d79) C=0xa77d;*/ else {\
94d9921999-03-20Henrik Grubbström (Grubba)  struct case_info *ci = find_ci(c); \ if (ci) { \ switch(ci->mode) { \
002bd52008-05-29Martin Nilsson  case CIM_NONE: case CIM_UPPERDELTA: case CIM_LONGUPPERDELTA: break; \
164d671999-03-20Henrik Grubbström (Grubba)  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; \
002bd52008-05-29Martin Nilsson  case CIM_LONGLOWERDELTA: \ C = c - ci->data - ( ci->data>0 ? 0x7fff : -0x8000 ); break; \
c6b6042008-05-03Martin Nilsson  DO_IF_DEBUG( default: Pike_fatal("upper_case(): Unknown case_info mode: %d\n", ci->mode); ) \
94d9921999-03-20Henrik Grubbström (Grubba)  } \
bd662f2004-04-12Per Hedbor  }} \
94d9921999-03-20Henrik Grubbström (Grubba)  } while(0)
480bf02000-07-27Andreas Lange #define DO_UPPER_CASE_SHIFT0(C) do {\
9776dd2001-06-21Henrik Grubbström (Grubba)  INT32 c = C; \
03c75f2004-10-14Martin Nilsson  if(c<0xb5){if(c >= 'a' && c <= 'z' ) C=c-0x20;}else {\
480bf02000-07-27Andreas Lange  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; \
c6b6042008-05-03Martin Nilsson  DO_IF_DEBUG( default: Pike_fatal("lower_case(): Unknown case_info mode: %d\n", ci->mode); ) \
480bf02000-07-27Andreas Lange  } \
bd662f2004-04-12Per Hedbor  }} \
480bf02000-07-27Andreas Lange  } while(0)
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string lower_case(string s)
6f18562003-09-05Henrik Grubbström (Grubba)  *! @decl int lower_case(int c)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
6f18562003-09-05Henrik Grubbström (Grubba)  *! Convert a string or character to lower case.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! @returns *! Returns a copy of the string @[s] with all upper case characters
6f18562003-09-05Henrik Grubbström (Grubba)  *! converted to lower case, or the character @[c] converted to lower *! case. *! *! @note *! Assumes the string or character to be coded according to
09bc452003-09-05Johan Sundström  *! ISO-10646 (aka Unicode). If they are not, @[Locale.Charset.decoder] *! can do the initial conversion for you.
6f18562003-09-05Henrik Grubbström (Grubba)  *! *! @note *! Prior to Pike 7.5 this function only accepted strings.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
09bc452003-09-05Johan Sundström  *! @[upper_case()], @[Locale.Charset.decoder]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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;
6f18562003-09-05Henrik Grubbström (Grubba)  check_all_args("lower_case", args, BIT_STRING|BIT_INT, 0); if (Pike_sp[-args].type == T_INT) { /* NOTE: Performs the case change in place. */ DO_LOWER_CASE(Pike_sp[-args].u.integer); pop_n_elems(args-1); return; }
c5ab042004-05-13Martin Nilsson  orig = Pike_sp[-args].u.string;
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]); }
c6b6042008-05-03Martin Nilsson #ifdef PIKE_DEBUG
94d9921999-03-20Henrik Grubbström (Grubba)  } else {
5aad932002-08-15Marcus Comstedt  Pike_fatal("lower_case(): Bad string shift:%d\n", orig->size_shift);
c6b6042008-05-03Martin Nilsson #endif
94d9921999-03-20Henrik Grubbström (Grubba)  }
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)
6f18562003-09-05Henrik Grubbström (Grubba)  *! @decl int upper_case(int c)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
6f18562003-09-05Henrik Grubbström (Grubba)  *! Convert a string or character to upper case.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! @returns *! Returns a copy of the string @[s] with all lower case characters
6f18562003-09-05Henrik Grubbström (Grubba)  *! converted to upper case, or the character @[c] converted to upper *! case. *! *! @note *! Assumes the string or character to be coded according to
09bc452003-09-05Johan Sundström  *! ISO-10646 (aka Unicode). If they are not, @[Locale.Charset.decoder] *! can do the initial conversion for you.
6f18562003-09-05Henrik Grubbström (Grubba)  *! *! @note *! Prior to Pike 7.5 this function only accepted strings.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
09bc452003-09-05Johan Sundström  *! @[lower_case()], @[Locale.Charset.decoder]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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;
6f18562003-09-05Henrik Grubbström (Grubba)  check_all_args("upper_case", args, BIT_STRING|BIT_INT, 0); if (Pike_sp[-args].type == T_INT) { /* NOTE: Performs the case change in place. */ DO_UPPER_CASE(Pike_sp[-args].u.integer); pop_n_elems(args-1); return; }
c5ab042004-05-13Martin Nilsson  orig = Pike_sp[-args].u.string;
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 {
c5ab042004-05-13Martin Nilsson  /* Ok, so our shiftsize 0 string contains 0xff or 0xb5 which prompts for a shiftsize 1 string. */ int j = orig->len; struct pike_string *wret = begin_wide_shared_string(j, 1); p_wchar1 *wstr = STR1(wret); /* Copy what we have done */ while(--j>i) wstr[j] = str[j]; /* upper case the rest */ i++; while(i--) switch( str[i] ) { case 0xff: wstr[i] = 0x178; break; case 0xb5: wstr[i] = 0x39c; break; default: DO_UPPER_CASE_SHIFT0(str[i]); wstr[i] = str[i]; break; } /* Discard the too narrow string and use the new one instead. */
fb22942008-06-16Martin Stjernholm  do_free_unlinked_pike_string(ret);
c5ab042004-05-13Martin Nilsson  ret = wret; break;
94d9921999-03-20Henrik Grubbström (Grubba)  } } } 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]); }
c6b6042008-05-03Martin Nilsson #ifdef PIKE_DEBUG
94d9921999-03-20Henrik Grubbström (Grubba)  } else {
5aad932002-08-15Marcus Comstedt  Pike_fatal("lower_case(): Bad string shift:%d\n", orig->size_shift);
c6b6042008-05-03Martin Nilsson #endif
94d9921999-03-20Henrik Grubbström (Grubba)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(end_shared_string(ret)); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl string random_string(int len) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Returns a string of random characters 0-255 with the length @[len].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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;
2575242004-05-14Martin Nilsson  get_all_args("random_string",args,"%+",&len);
283ec72000-04-15Fredrik Hübinette (Hubbe)  ret = begin_shared_string(len);
1f88bf2001-09-24Henrik Grubbström (Grubba)  for(e=0;e<len;e++) ret->str[e] = DO_NOT_WARN((char)my_rand());
283ec72000-04-15Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(end_shared_string(ret)); }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl void random_seed(int seed) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function sets the initial value for the random generator.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[random()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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() *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Returns the number of arguments given when the previous function was *! called.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This is useful for functions that take a variable number of arguments.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[call_function()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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) }
9cf6c82001-03-11Henrik Grubbström (Grubba) /*! @decl int search(string haystack, string|int needle, int|void start)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! @decl int search(array haystack, mixed needle, int|void start) *! @decl mixed search(mapping haystack, mixed needle, mixed|void start)
b5b59a2003-09-04Henrik Grubbström (Grubba)  *! @decl mixed search(object haystack, mixed needle, mixed|void start)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Search for @[needle] in @[haystack]. Return the position of @[needle] in
cbe8c92003-04-07Martin Nilsson  *! @[haystack] or @expr{-1@} if not found.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! If the optional argument @[start] is present search is started at *! this position.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
b5b59a2003-09-04Henrik Grubbström (Grubba)  *! @mixed haystack *! @type string *! When @[haystack] is a string @[needle] must be a string or an int, *! and the first occurrence of the string or int is returned. *! *! @type array *! When @[haystack] is an array, @[needle] is compared only to *! one value at a time in @[haystack]. *! *! @type mapping *! 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. *! *! @type object *! When @[haystack] is an object implementing @[lfun::_search()], *! the result of calling @[lfun::_search()] with @[needle] will *! be returned. *! *! If @[haystack] is an object that doesn't implement @[lfun::_search()] *! it is assumed to be an @[Iterator], and implement *! @[Iterator()->index()], @[Iterator()->value()], and *! @[Iterator()->next()]. @[search()] will then start comparing *! elements with @[`==()] until a match with @[needle] is found. *! If @[needle] is found @[haystack] will be advanced to the element, *! and the iterator index will be returned. If @[needle] is not *! found, @[haystack] will be advanced to the end (and will thus *! evaluate to false), and a zero with zero_type 1 will be returned. *! @endmixed
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
b5b59a2003-09-04Henrik Grubbström (Grubba)  *! @note *! If @[start] is supplied to an iterator object without an *! @[lfun::_search()], @[haystack] will need to implement *! @[Iterator()->set_index()].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
594f162007-01-15Henrik Grubbström (Grubba)  *! @note *! For mappings and object @[UNDEFINED] will be returned when not found. *! In all other cases @expr{-1@} will be returned when not found. *!
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! @seealso
38cb402010-03-30Peter Bortas  *! @[indices()], @[values()], @[zero_type()], @[has_value()], *! @[has_prefix()], @[has_suffix()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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: {
9cf6c82001-03-11Henrik Grubbström (Grubba)  struct pike_string *haystack = Pike_sp[-args].u.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)  }
9cf6c82001-03-11Henrik Grubbström (Grubba)  if(haystack->len < start) bad_arg_error("search", Pike_sp-args, args, 3, "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) 
f05e112009-09-09Henrik Grubbström (Grubba)  if ((Pike_sp[1-args].type == T_INT) || ((Pike_sp[1-args].type == T_STRING) && (Pike_sp[1-args].u.string->len == 1))) { INT_TYPE val; if (Pike_sp[1-args].type == T_INT) { val = Pike_sp[1-args].u.integer; } else { val = index_shared_string(Pike_sp[1-args].u.string, 0);
e38ce92001-10-30Henrik Grubbström (Grubba)  }
9cf6c82001-03-11Henrik Grubbström (Grubba)  switch(Pike_sp[-args].u.string->size_shift) { case 0: { p_wchar0 *str = STR0(haystack); if (val >= 256) { start = -1; break; } while (start < haystack->len) { if (str[start] == val) break; start++; } } break; case 1: { p_wchar1 *str = STR1(haystack); if (val >= 65536) { start = -1; break; } while (start < haystack->len) { if (str[start] == val) break; start++; } } break; case 2: { p_wchar2 *str = STR2(haystack); while (start < haystack->len) { if (str[start] == (p_wchar2)val) break; start++; } } break;
c6b6042008-05-03Martin Nilsson #ifdef PIKE_DEBUG
9cf6c82001-03-11Henrik Grubbström (Grubba)  default:
5aad932002-08-15Marcus Comstedt  Pike_fatal("search(): Unsupported string shift: %d!\n",
9cf6c82001-03-11Henrik Grubbström (Grubba)  haystack->size_shift); break;
c6b6042008-05-03Martin Nilsson #endif
9cf6c82001-03-11Henrik Grubbström (Grubba)  } if (start >= haystack->len) { start = -1; }
f05e112009-09-09Henrik Grubbström (Grubba)  } else if(Pike_sp[1-args].type == T_STRING) { /* Handle searching for the empty string. */ if (Pike_sp[1-args].u.string->len) { start = string_search(haystack, Pike_sp[1-args].u.string, start); }
9cf6c82001-03-11Henrik Grubbström (Grubba)  } else { SIMPLE_BAD_ARG_ERROR("search", 2, "string | int"); }
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;
b5b59a2003-09-04Henrik Grubbström (Grubba)  case T_OBJECT:
f54c782004-12-22Henrik Grubbström (Grubba)  { struct program *p; if ((p = (Pike_sp[-args].u.object->prog))) { struct object *o = Pike_sp[-args].u.object; int id_level = p->inherits[Pike_sp[-args].subtype].identifier_level; int id; int next, ind; p = p->inherits[Pike_sp[-args].subtype].prog; /* NOTE: Fake lfun! */ id = low_find_lfun(p, LFUN__SEARCH); /* First try lfun::_search(). */ if (id >= 0) { apply_low(o, id + id_level, args-1); stack_pop_n_elems_keep_top(1); return;
b5b59a2003-09-04Henrik Grubbström (Grubba)  }
f54c782004-12-22Henrik Grubbström (Grubba)  /* Check if we have an iterator. */ if (((id = find_identifier("value", p)) >= 0) && ((next = find_identifier("next", p)) >= 0) && ((ind = find_identifier("index", p)) >= 0)) { /* We have an iterator. */ id += id_level; next += id_level; ind += id_level; /* Set the start position if needed. */ if (args > 2) { int fun = find_identifier("set_index", p); if (fun < 0) Pike_error ("Cannot call unknown function \"%s\".\n", fun); apply_low(o, fun + id_level, args-2); pop_stack();
b5b59a2003-09-04Henrik Grubbström (Grubba)  }
f54c782004-12-22Henrik Grubbström (Grubba)  /* At this point we have two values on the stack. */ while(1) { apply_low(o, id, 0); if (is_eq(Pike_sp-2, Pike_sp-1)) { /* Found. */ apply_low(o, ind, 0); stack_pop_n_elems_keep_top(3); return; } apply_low(o, next, 0); if (UNSAFE_IS_ZERO(Pike_sp-1)) { /* Not found. */ pop_n_elems(4); /* FIXME: Should probably indicate not found in some other way. * On the other hand, the iterator should be false now. */ push_undefined(); return; } pop_n_elems(2);
b5b59a2003-09-04Henrik Grubbström (Grubba)  } } } } /* FALL_THROUGH */
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
b5b59a2003-09-04Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("search", 1, "string|array|mapping|object");
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
929a862010-02-23Henrik Grubbström (Grubba) /*! @decl int has_prefix(string|object s, string prefix)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if the string @[s] starts with @[prefix], *! returns @expr{0@} (zero) otherwise.
38cb402010-03-30Peter Bortas  *! *! @seealso *! @[has_suffix()], @[has_value()], @[search()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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;
7d1e032004-05-18Martin Nilsson  if(args<2) SIMPLE_TOO_FEW_ARGS_ERROR("has_prefix", 2);
929a862010-02-23Henrik Grubbström (Grubba)  if((Pike_sp[-args].type!=T_STRING) && (Pike_sp[-args].type!=T_OBJECT)) SIMPLE_ARG_TYPE_ERROR("has_prefix", 1, "string|object");
7d1e032004-05-18Martin Nilsson  if(Pike_sp[1-args].type!=T_STRING) SIMPLE_ARG_TYPE_ERROR("has_prefix", 2, "string"); b = Pike_sp[1-args].u.string;
a4f17f2000-04-12Henrik Grubbström (Grubba) 
929a862010-02-23Henrik Grubbström (Grubba)  if (Pike_sp[-args].type == T_OBJECT) { ptrdiff_t i; struct object *o = Pike_sp[-args].u.object; int inherit_no = Pike_sp[-args].subtype; push_int(0); for (i = 0; i < b->len; i++) { p_wchar2 ch = index_shared_string(b, i); Pike_sp[-1].u.integer = i; /* Note: Integers do not need to be freed. */ object_index_no_free(Pike_sp-1, o, inherit_no, Pike_sp-1);
36f1052010-02-23Henrik Grubbström (Grubba)  if (Pike_sp[-1].type != PIKE_T_INT) {
929a862010-02-23Henrik Grubbström (Grubba)  Pike_error("Unexepected value returned from index operator.\n"); } if (ch != Pike_sp[-1].u.integer) { pop_n_elems(args + 1); push_int(0); return; } }
36f1052010-02-23Henrik Grubbström (Grubba)  pop_n_elems(args+1);
929a862010-02-23Henrik Grubbström (Grubba)  push_int(1); return; } a = Pike_sp[-args].u.string;
a4f17f2000-04-12Henrik Grubbström (Grubba)  /* 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) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if the string @[s] ends with @[suffix], *! returns @expr{0@} (zero) otherwise.
38cb402010-03-30Peter Bortas  *! *! @seealso *! @[has_prefix()], @[has_value()], @[search()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
54277b2000-12-18Henrik Grubbström (Grubba) PMOD_EXPORT void f_has_suffix(INT32 args) { struct pike_string *a, *b;
7d1e032004-05-18Martin Nilsson  if(args<2) SIMPLE_TOO_FEW_ARGS_ERROR("has_suffix", 2); if(Pike_sp[-args].type!=T_STRING) SIMPLE_ARG_TYPE_ERROR("has_suffix", 1, "string"); if(Pike_sp[1-args].type!=T_STRING) SIMPLE_ARG_TYPE_ERROR("has_suffix", 2, "string"); a = Pike_sp[-args].u.string; b = Pike_sp[1-args].u.string;
54277b2000-12-18Henrik Grubbström (Grubba)  /* 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)
01587a2003-06-03Martin Stjernholm  *! @decl int has_index(mapping|multiset|object|program haystack, mixed index)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Search for @[index] in @[haystack].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! @returns
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[index] is in the index domain of @[haystack], *! or @expr{0@} (zero) if not found.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function is equivalent to (but sometimes faster than):
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
f79bd82003-04-01Martin Nilsson  *! @code *! search(indices(haystack), index) != -1 *! @endcode
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! A negative index in strings and arrays as recognized by the
cbe8c92003-04-07Martin Nilsson  *! index operators @expr{`[]()@} and @expr{`[]=()@} is not considered
554e222001-05-06Henrik Grubbström (Grubba)  *! a proper index by @[has_index()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
38cb402010-03-30Peter Bortas  *! @[has_value()], @[has_prefix()], @[has_suffix()], @[indices()], *! @[search()], @[values()], @[zero_type()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_has_index(INT32 args)
538a892000-01-21Fredrik Noring { int t = 0;
e74e2c2003-01-05Martin Nilsson  if(args < 2) SIMPLE_TOO_FEW_ARGS_ERROR("has_index", 2); if(args > 2) pop_n_elems(args-2);
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);
89c91b2008-01-05Martin Nilsson #ifdef PIKE_DEBUG if(Pike_sp[-1].type != T_INT)
538a892000-01-21Fredrik Noring  PIKE_ERROR("has_index",
edf4d02000-07-06Fredrik Hübinette (Hubbe)  "Function `zero_type' gave incorrect result.\n", Pike_sp, args);
89c91b2008-01-05Martin Nilsson #endif Pike_sp[-1].u.integer = !Pike_sp[-1].u.integer;
538a892000-01-21Fredrik Noring  break; case T_OBJECT:
01587a2003-06-03Martin Stjernholm  case T_PROGRAM:
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 */
89c91b2008-01-05Martin Nilsson  /* If it is an iterator object we may want to use the iterator interface to look for the index. */
538a892000-01-21Fredrik Noring  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);
01587a2003-06-03Martin Stjernholm  break; default: SIMPLE_ARG_TYPE_ERROR ("has_index", 1, "string|array|mapping|multiset|object|program");
538a892000-01-21Fredrik Noring  } }
9cf6c82001-03-11Henrik Grubbström (Grubba) /*! @decl int has_value(string haystack, string value) *! @decl int has_value(string haystack, int value)
01587a2003-06-03Martin Stjernholm  *! @decl int has_value(array|mapping|object|program haystack, mixed value)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Search for @[value] in @[haystack].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! @returns
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[value] is in the value domain of @[haystack], *! or @expr{0@} (zero) if not found.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function is in all cases except when both arguments are strings *! equivalent to (but sometimes faster than):
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
f79bd82003-04-01Martin Nilsson  *! @code *! search(values(@[haystack]), @[value]) != -1 *! @endcode
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! If both arguments are strings, @[has_value()] is equivalent to:
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
f79bd82003-04-01Martin Nilsson  *! @code *! search(@[haystack], @[value]) != -1 *! @endcode
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
38cb402010-03-30Peter Bortas  *! @[has_index()], @[indices()], @[search()], @[has_prefix()], *! @[has_suffix()], @[values()], @[zero_type()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_has_value(INT32 args)
538a892000-01-21Fredrik Noring {
e74e2c2003-01-05Martin Nilsson  if(args < 2) SIMPLE_TOO_FEW_ARGS_ERROR("has_value", 2); if(args > 2) pop_n_elems(args-2);
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;
01587a2003-06-03Martin Stjernholm  case T_PROGRAM:
538a892000-01-21Fredrik Noring  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
f54c782004-12-22Henrik Grubbström (Grubba)  use `search' directly since it's undefined whether it returns
538a892000-01-21Fredrik Noring  -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 */
9cf6c82001-03-11Henrik Grubbström (Grubba)  /* FALL_THROUGH */
01587a2003-06-03Martin Stjernholm  case T_MULTISET: /* FIXME: This behavior for multisets isn't clean. It should be * compat only. */
538a892000-01-21Fredrik Noring  stack_swap(); f_values(1); stack_swap();
01587a2003-06-03Martin Stjernholm  /* FALL_THROUGH */
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);
01587a2003-06-03Martin Stjernholm  break; default: SIMPLE_ARG_TYPE_ERROR ("has_value", 1, "string|array|mapping|object|program");
538a892000-01-21Fredrik Noring  } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl void add_constant(string name, mixed value) *! @decl void add_constant(string name) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Add a new predefined constant.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function is often used to add builtin functions. *! All programs compiled after the @[add_constant()] function has been *! called can access @[value] by the name @[name].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! If there is a constant called @[name] already, it will be replaced by *! by the new definition. This will not affect already compiled programs.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[all_constants()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_add_constant(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
8111162003-09-07Martin Nilsson  ASSERT_SECURITY_ROOT("add_constant");
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); }
f7fb1a2004-05-01Martin Stjernholm /*! @decl string combine_path(string path, string ... paths) *! @decl string combine_path_unix(string path, string ... paths) *! @decl string combine_path_nt(string path, string ... paths) *! @decl string combine_path_amigaos(string path, string ... paths) *! *! Concatenate a number of paths to a straightforward path without *! any @expr{"//"@}, @expr{"/.."@} or @expr{"/."@}. If any path *! argument is absolute then the result is absolute and the *! preceding arguments are ignored. If the result is relative then *! it might have leading @expr{".."@} components. If the last *! nonempty argument ends with a directory separator then the *! result ends with that too. If all components in a relative path *! disappear due to subsequent @expr{".."@} components then the *! result is @expr{"."@}.
97e8162004-05-01Martin Stjernholm  *! *! @[combine_path_unix()] concatenates in UNIX style, which also is *! appropriate for e.g. URL:s ("/" separates path components and *! absolute paths start with "/"). @[combine_path_nt()] *! concatenates according to NT filesystem conventions ("/" and "\" *! separates path components and there might be a drive letter in *! front of absolute paths). @[combine_path_amigaos()] concatenates *! according to AmigaOS filesystem conventions. *! *! @[combine_path()] is equivalent to @[combine_path_unix()] on UNIX-like
81ffaa2003-12-18Marcus Comstedt  *! operating systems, and equivalent to @[combine_path_nt()] on NT-like *! operating systems, and equivalent to @[combine_path_amigaos()] on *! AmigaOS-like operating systems.
9849a72001-06-08Henrik Grubbström (Grubba)  *!
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[getcwd()], @[Stdio.append_path()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
05459a1998-04-09Fredrik Hübinette (Hubbe) 
8e06782001-06-07Fredrik Hübinette (Hubbe) #define NT_COMBINE_PATH #include "combine_path.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) 
8e06782001-06-07Fredrik Hübinette (Hubbe) #define UNIX_COMBINE_PATH #include "combine_path.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) 
81ffaa2003-12-18Marcus Comstedt #define AMIGAOS_COMBINE_PATH #include "combine_path.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) 
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int zero_type(mixed a) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Return the type of zero.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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()].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! @returns *! When doing a @[find_call_out()] or mapping lookup, @[zero_type()] on
cbe8c92003-04-07Martin Nilsson  *! this value will return @expr{1@} if there was no such thing present in
554e222001-05-06Henrik Grubbström (Grubba)  *! the mapping, or if no such @tt{call_out@} could be found.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! If the argument to @[zero_type()] is a destructed object or a function
cbe8c92003-04-07Martin Nilsson  *! in a destructed object, @expr{2@} will be returned.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! In all other cases @[zero_type()] will return @expr{0@} (zero).
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
8459bf2001-07-27Martin Nilsson  *! @[find_call_out()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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);
eaa4da2001-10-04Fredrik Hübinette (Hubbe)  if((Pike_sp[-args].type==T_OBJECT || Pike_sp[-args].type==T_FUNCTION) && !Pike_sp[-args].u.object->prog)
3f6d8f1996-11-26Fredrik Hübinette (Hubbe)  { pop_n_elems(args);
eaa4da2001-10-04Fredrik Hübinette (Hubbe)  push_int(NUMBER_DESTRUCTED);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  }
eaa4da2001-10-04Fredrik Hübinette (Hubbe)  else if(Pike_sp[-args].type != T_INT)
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  { pop_n_elems(args);
eaa4da2001-10-04Fredrik Hübinette (Hubbe)  push_int(0);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  }
eaa4da2001-10-04Fredrik Hübinette (Hubbe)  else
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  {
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) }
0811472001-07-02Fredrik Hübinette (Hubbe) static int generate_zero_type(node *n) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION; CHECK_COMPILER();
0811472001-07-02Fredrik Hübinette (Hubbe)  if(count_args(CDR(n)) != 1) return 0; if(do_docode(CDR(n),DO_NOT_COPY) != 1)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Count args was wrong in generate_zero_type().\n");
0811472001-07-02Fredrik Hübinette (Hubbe)  emit0(F_ZERO_TYPE); return 1; }
4643ea1998-10-10Henrik Grubbström (Grubba) /* * Some wide-strings related functions */
f23c5d2007-06-02Martin Bähr /*! @decl string(0..255) string_to_unicode(string s)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Converts a string into an UTF16 compliant byte-stream.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Characters in range 0x010000 - 0x10ffff are encoded using surrogates.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
a056042001-10-28Martin Nilsson  *! @[Locale.Charset.decoder()], @[string_to_utf8()], @[unicode_to_string()],
554e222001-05-06Henrik Grubbström (Grubba)  *! @[utf8_to_string()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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]) {
5aad932002-08-15Marcus Comstedt  Pike_fatal("MEMSET didn't clear byte %ld of %ld\n",
d1cac52000-09-07Henrik Grubbström (Grubba)  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) "
b99d882003-05-15Martin Stjernholm  "is out of range (0x00000000..0x0010ffff).",
69bb402000-08-17Henrik Grubbström (Grubba)  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) {
5aad932002-08-15Marcus Comstedt  Pike_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;
c6b6042008-05-03Martin Nilsson #ifdef PIKE_DEBUG
4643ea1998-10-10Henrik Grubbström (Grubba)  default:
c6b6042008-05-03Martin Nilsson  Pike_fatal("string_to_unicode(): Bad string shift: %d!\n", in->size_shift);
4643ea1998-10-10Henrik Grubbström (Grubba)  break;
c6b6042008-05-03Martin Nilsson #endif
4643ea1998-10-10Henrik Grubbström (Grubba)  } pop_n_elems(args); push_string(out); }
f23c5d2007-06-02Martin Bähr /*! @decl string unicode_to_string(string(0..255) s)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Converts an UTF16 byte-stream into a string.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! This function did not decode surrogates in Pike 7.2 and earlier.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
a056042001-10-28Martin Nilsson  *! @[Locale.Charset.decoder()], @[string_to_unicode()], @[string_to_utf8()],
554e222001-05-06Henrik Grubbström (Grubba)  *! @[utf8_to_string()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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;
f272792001-04-18Marcus Comstedt  ptrdiff_t len, i, num_surrogates = 0; int swab=0; p_wchar1 surr1, surr2, surrmask, *str0;
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)  }
f272792001-04-18Marcus Comstedt  /* Check byteorder of UTF data */ str0 = (p_wchar1 *)in->str; len = in->len;
2f1f3e2001-05-03Henrik Grubbström (Grubba)  if (len && (str0[0] == 0xfeff)) {
f272792001-04-18Marcus Comstedt  /* Correct byte order mark. No swap necessary. */ swab = 0; str0 ++; len -= 2;
2f1f3e2001-05-03Henrik Grubbström (Grubba)  } else if (len && (str0[0] == 0xfffe)) {
f272792001-04-18Marcus Comstedt  /* Reversed byte order mark. Need to swap. */ swab = 1; str0 ++; len -= 2; } else { /* No byte order mark. Need to swap unless big endian */
71f3a21998-11-22Fredrik Hübinette (Hubbe) #if (PIKE_BYTEORDER == 4321)
f272792001-04-18Marcus Comstedt  swab = 0;
4643ea1998-10-10Henrik Grubbström (Grubba) #else
f272792001-04-18Marcus Comstedt  swab = 1; #endif /* PIKE_BYTEORDER == 4321 */ } /* Indentify surrogates by pre-swapped bitmasks, for efficiency */ if (swab) { surr1 = 0xd8; surr2 = 0xdc; surrmask = 0xfc; } else { surr1 = 0xd800; surr2 = 0xdc00; surrmask = 0xfc00; } /* Count number of surrogates */ for (i = len; i >= 4; i -= 2, str0++) if ( (str0[0]&surrmask) == surr1 && (str0[1]&surrmask) == surr2 ) num_surrogates ++; /* Move str0 past the last word */ str0++; len = len / 2 - num_surrogates; out = begin_wide_shared_string(len, (num_surrogates? 2 : 1)); if (!swab) { /* Native endian */ if (num_surrogates) { /* Convert surrogates */ p_wchar2 *str2 = STR2(out); for (i = len; i--; --str0) if ((str0[-1]&surrmask) == surr2 && num_surrogates && (str0[-2]&surrmask) == surr1) { str2[i] = ((str0[-2]&0x3ff)<<10) + (str0[-1]&0x3ff) + 0x10000;
4643ea1998-10-10Henrik Grubbström (Grubba) 
f272792001-04-18Marcus Comstedt  --str0; --num_surrogates; } else str2[i] = str0[-1]; } else /* * FIXME: Future optimization: Perform sufficient magic * to do the conversion in place if the ref-count is == 1. */ MEMCPY(out->str, (char *)(str0-len), len*2); } else { /* Reverse endian */ if (num_surrogates) { /* Convert surrogates */ p_wchar2 *str2 = STR2(out);
2f1f3e2001-05-03Henrik Grubbström (Grubba)  for (i = len; i--; --str0) {
f272792001-04-18Marcus Comstedt  if ((str0[-1]&surrmask) == surr2 && num_surrogates && (str0[-2]&surrmask) == surr1) {
2f1f3e2001-05-03Henrik Grubbström (Grubba) #if (PIKE_BYTEORDER == 4321)
bdafb52001-05-08Henrik Grubbström (Grubba)  str2[i] = ((((unsigned char *)str0)[-3]&3)<<18) + (((unsigned char *)str0)[-4]<<10) + ((((unsigned char *)str0)[-1]&3)<<8) + ((unsigned char *)str0)[-2] +
2f1f3e2001-05-03Henrik Grubbström (Grubba)  0x10000; #else /* PIKE_BYTEORDER != 4321 */
f272792001-04-18Marcus Comstedt  str2[i] = ((((unsigned char *)str0)[-4]&3)<<18) + (((unsigned char *)str0)[-3]<<10) + ((((unsigned char *)str0)[-2]&3)<<8) + ((unsigned char *)str0)[-1] + 0x10000;
2f1f3e2001-05-03Henrik Grubbström (Grubba) #endif /* PIKE_BYTEORDER == 4321 */
f272792001-04-18Marcus Comstedt  --str0; --num_surrogates;
2f1f3e2001-05-03Henrik Grubbström (Grubba)  } else { #if (PIKE_BYTEORDER == 4321) str2[i] = (((unsigned char *)str0)[-1]<<8) + ((unsigned char *)str0)[-2]; #else /* PIKE_BYTEORDER != 4321 */
f272792001-04-18Marcus Comstedt  str2[i] = (((unsigned char *)str0)[-2]<<8) + ((unsigned char *)str0)[-1];
2f1f3e2001-05-03Henrik Grubbström (Grubba) #endif /* PIKE_BYTEORDER == 4321 */ } }
f272792001-04-18Marcus Comstedt  } else { /* No surrogates */ p_wchar1 *str1 = STR1(out);
2f1f3e2001-05-03Henrik Grubbström (Grubba)  for (i = len; i--; --str0) { #if (PIKE_BYTEORDER == 4321) str1[i] = (((unsigned char *)str0)[-1]<<8) + ((unsigned char *)str0)[-2]; #else /* PIKE_BYTEORDER != 4321 */
f272792001-04-18Marcus Comstedt  str1[i] = (((unsigned char *)str0)[-2]<<8) + ((unsigned char *)str0)[-1];
2f1f3e2001-05-03Henrik Grubbström (Grubba) #endif /* PIKE_BYTEORDER == 4321 */ }
4643ea1998-10-10Henrik Grubbström (Grubba)  } } out = end_shared_string(out); pop_n_elems(args); push_string(out); }
f23c5d2007-06-02Martin Bähr /*! @decl string(0..255) string_to_utf8(string s) *! @decl string(0..255) string_to_utf8(string s, int extended)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
dee8942005-04-02Martin Stjernholm  *! Converts a string into an UTF-8 compliant byte-stream.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @note
dee8942005-04-02Martin Stjernholm  *! Throws an error if characters not valid in an UTF-8 stream are *! encountered. Valid characters are in the ranges *! @expr{0x00000000-0x0000d7ff@} and @expr{0x0000e000-0x0010ffff@}.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
dee8942005-04-02Martin Stjernholm  *! If @[extended] is 1 then characters outside the valid ranges are *! accepted too and encoded using the same algorithm. Such encoded *! characters are however not UTF-8 compliant.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
a056042001-10-28Martin Nilsson  *! @[Locale.Charset.encoder()], @[string_to_unicode()],
554e222001-05-06Henrik Grubbström (Grubba)  *! @[unicode_to_string()], @[utf8_to_string()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
77cc592003-11-14Martin Stjernholm PMOD_EXPORT void f_string_to_utf8(INT32 args)
be40771998-10-15Henrik Grubbström (Grubba) {
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;
2adf002004-02-29Martin Stjernholm  INT_TYPE extended = 0;
be40771998-10-15Henrik Grubbström (Grubba) 
2adf002004-02-29Martin Stjernholm  get_all_args("string_to_utf8", args, "%W.%i", &in, &extended);
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++;
dee8942005-04-02Martin Stjernholm  if (!extended && c > 0x10ffff) bad_arg_error ("string_to_utf8", Pike_sp - args, args, 1, NULL, Pike_sp - args, "Character 0x%08x at index %"PRINTPTRDIFFT"d is " "outside the allowed range.\n", c, i);
be40771998-10-15Henrik Grubbström (Grubba)  if (c & ~0x1fffff) { /* 22bit or more. */ len++; if (c & ~0x3ffffff) { /* 27bit or more. */ len++; if (c & ~0x7fffffff) { /* 32bit or more. */ len++; /* FIXME: Needs fixing when we get 64bit chars... */ } } } }
dee8942005-04-02Martin Stjernholm  else if (!extended && c >= 0xd800 && c <= 0xdfff) bad_arg_error ("string_to_utf8", Pike_sp - args, args, 1, NULL, Pike_sp - args, "Character 0x%08x at index %"PRINTPTRDIFFT"d is " "in the surrogate range and therefore invalid.\n", c, i);
be40771998-10-15Henrik Grubbström (Grubba)  } } } 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 { /* 32 - 36bit */
1f88bf2001-09-24Henrik Grubbström (Grubba)  out->str[j++] = DO_NOT_WARN((char)0xfe);
be40771998-10-15Henrik Grubbström (Grubba)  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) {
5aad932002-08-15Marcus Comstedt  Pike_fatal("string_to_utf8(): Calculated and actual lengths differ: "
dee8942005-04-02Martin Stjernholm  "%"PRINTPTRDIFFT"d != %"PRINTPTRDIFFT"d\n", len, 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); }
f23c5d2007-06-02Martin Bähr /*! @decl string utf8_to_string(string(0..255) s) *! @decl string utf8_to_string(string(0..255) s, int extended)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
dee8942005-04-02Martin Stjernholm  *! Converts an UTF-8 byte-stream into a string.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @note
dee8942005-04-02Martin Stjernholm  *! Throws an error if the stream is not a legal UTF-8 byte-stream.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
7931822005-08-01Martin Stjernholm  *! Accepts and decodes the extension used by @[string_to_utf8()] if
cbe8c92003-04-07Martin Nilsson  *! @[extended] is @expr{1@}.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
dee8942005-04-02Martin Stjernholm  *! @note *! In conformance with RFC 3629 and Unicode 3.1 and later,
7931822005-08-01Martin Stjernholm  *! non-shortest forms are not decoded. An error is thrown instead.
dee8942005-04-02Martin Stjernholm  *!
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! @seealso
a056042001-10-28Martin Nilsson  *! @[Locale.Charset.encoder()], @[string_to_unicode()], @[string_to_utf8()],
554e222001-05-06Henrik Grubbström (Grubba)  *! @[unicode_to_string()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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;
dee8942005-04-02Martin Stjernholm  ptrdiff_t len = 0;
be40771998-10-15Henrik Grubbström (Grubba)  int shift = 0;
cc724f2005-05-05Martin Nilsson  ptrdiff_t i,j=0;
2adf002004-02-29Martin Stjernholm  INT_TYPE extended = 0;
be40771998-10-15Henrik Grubbström (Grubba) 
2adf002004-02-29Martin Stjernholm  get_all_args("utf8_to_string", args, "%S.%i", &in, &extended);
ed65901998-10-31Henrik Grubbström (Grubba) 
be40771998-10-15Henrik Grubbström (Grubba)  for(i=0; i < in->len; i++) {
57dd672005-04-02Martin Stjernholm  unsigned int c = STR0(in)[i];
be40771998-10-15Henrik Grubbström (Grubba)  len++; if (c & 0x80) { int cont = 0;
dee8942005-04-02Martin Stjernholm  /* From table 3-6 in the Unicode standard 4.0: Well-Formed UTF-8 * Byte Sequences * * Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte * 000000-00007f 00-7f * 000080-0007ff c2-df 80-bf * 000800-000fff e0 a0-bf 80-bf * 001000-00cfff e1-ec 80-bf 80-bf * 00d000-00d7ff ed 80-9f 80-bf * 00e000-00ffff ee-ef 80-bf 80-bf * 010000-03ffff f0 90-bf 80-bf 80-bf * 040000-0fffff f1-f3 80-bf 80-bf 80-bf * 100000-10ffff f4 80-8f 80-bf 80-bf */
be40771998-10-15Henrik Grubbström (Grubba)  if ((c & 0xc0) == 0x80) {
dee8942005-04-02Martin Stjernholm  bad_arg_error ("utf8_to_string", Pike_sp - args, args, 1, NULL, Pike_sp - args, "Invalid continuation character 0x%02x " "at index %"PRINTPTRDIFFT"d.\n", c, i);
be40771998-10-15Henrik Grubbström (Grubba)  }
dee8942005-04-02Martin Stjernholm  #define GET_CONT_CHAR(in, i, c) do { \ i++; \ if (i >= in->len) \ bad_arg_error ("utf8_to_string", Pike_sp - args, args, 1, \ NULL, Pike_sp - args, \ "Truncated UTF-8 sequence at end of string.\n"); \
57dd672005-04-02Martin Stjernholm  c = STR0 (in)[i]; \
dee8942005-04-02Martin Stjernholm  if ((c & 0xc0) != 0x80) \ bad_arg_error ("utf8_to_string", Pike_sp - args, args, 1, \ NULL, Pike_sp - args, \ "Expected continuation character at index %d, " \ "got 0x%02x.\n", \ i, c); \ } while (0) #define UTF8_SEQ_ERROR(prefix, c, i, problem) do { \ bad_arg_error ("utf8_to_string", Pike_sp - args, args, 1, \ NULL, Pike_sp - args, \ "UTF-8 sequence beginning with %s0x%02x " \ "at index %"PRINTPTRDIFFT"d %s.\n", \ prefix, c, i, problem); \ } while (0)
be40771998-10-15Henrik Grubbström (Grubba)  if ((c & 0xe0) == 0xc0) { /* 11bit */
dee8942005-04-02Martin Stjernholm  if (!(c & 0x1e)) UTF8_SEQ_ERROR ("", c, i, "is a non-shortest form");
be40771998-10-15Henrik Grubbström (Grubba)  cont = 1; if (c & 0x1c) { if (shift < 1) { shift = 1; } }
dee8942005-04-02Martin Stjernholm  } else if ((c & 0xf0) == 0xe0) {
be40771998-10-15Henrik Grubbström (Grubba)  /* 16bit */
dee8942005-04-02Martin Stjernholm  if (c == 0xe0) { GET_CONT_CHAR (in, i, c); if (!(c & 0x20)) UTF8_SEQ_ERROR ("0xe0 ", c, i - 1, "is a non-shortest form"); cont = 1; } else if (!extended && c == 0xed) { GET_CONT_CHAR (in, i, c); if (c > 0x9f) UTF8_SEQ_ERROR ("0xed ", c, i - 1, "would decode to " "an invalid surrogate character"); cont = 1; } else cont = 2;
be40771998-10-15Henrik Grubbström (Grubba)  if (shift < 1) { shift = 1; }
dee8942005-04-02Martin Stjernholm  } else {
be40771998-10-15Henrik Grubbström (Grubba)  if ((c & 0xf8) == 0xf0) { /* 21bit */
dee8942005-04-02Martin Stjernholm  if (c == 0xf0) { GET_CONT_CHAR (in, i, c); if (!(c & 0x30)) UTF8_SEQ_ERROR ("0xf0 ", c, i - 1, "is a non-shortest form"); cont = 2;
ed65901998-10-31Henrik Grubbström (Grubba)  }
dee8942005-04-02Martin Stjernholm  else if (!extended) { if (c > 0xf4) UTF8_SEQ_ERROR ("", c, i, "would decode to " "a character outside the valid UTF-8 range"); else if (c == 0xf4) { GET_CONT_CHAR (in, i, c); if (c > 0x8f) UTF8_SEQ_ERROR ("0xf4 ", c, i - 1, "would decode to " "a character outside the valid UTF-8 range"); cont = 2; } else cont = 3; } else cont = 3;
be40771998-10-15Henrik Grubbström (Grubba)  }
dee8942005-04-02Martin Stjernholm  else if (c == 0xff) bad_arg_error ("utf8_to_string", Pike_sp - args, args, 1, NULL, Pike_sp - args, "Invalid character 0xff at index %"PRINTPTRDIFFT"d.\n", i); else if (!extended) UTF8_SEQ_ERROR ("", c, i, "would decode to " "a character outside the valid UTF-8 range"); else { if ((c & 0xfc) == 0xf8) { /* 26bit */ if (c == 0xf8) { GET_CONT_CHAR (in, i, c); if (!(c & 0x38)) UTF8_SEQ_ERROR ("0xf8 ", c, i - 1, "is a non-shortest form"); cont = 3; } else cont = 4; } else if ((c & 0xfe) == 0xfc) { /* 31bit */ if (c == 0xfc) { GET_CONT_CHAR (in, i, c); if (!(c & 0x3c)) UTF8_SEQ_ERROR ("0xfc ", c, i - 1, "is a non-shortest form"); cont = 4; } else cont = 5; } else if (c == 0xfe) { /* 36bit */ GET_CONT_CHAR (in, i, c); if (!(c & 0x3e)) UTF8_SEQ_ERROR ("0xfe ", c, i - 1, "is a non-shortest form"); else if (c & 0x3c) UTF8_SEQ_ERROR ("0xfe ", c, i - 1, "would decode to " "a too large character value"); cont = 5; }
be40771998-10-15Henrik Grubbström (Grubba)  }
57dd672005-04-02Martin Stjernholm  if (shift < 2) shift = 2;
be40771998-10-15Henrik Grubbström (Grubba)  }
dee8942005-04-02Martin Stjernholm  while(cont--) GET_CONT_CHAR (in, i, c);
57dd672005-04-02Martin Stjernholm  #undef GET_CONT_CHAR #undef UTF8_SEQ_ERROR
be40771998-10-15Henrik Grubbström (Grubba)  } } if (len == in->len) { /* 7bit in == 7bit out */ pop_n_elems(args-1); return; } out = begin_wide_shared_string(len, shift);
57dd672005-04-02Martin Stjernholm  switch (shift) { case 0: {
cfd6422005-04-02Martin Stjernholm  p_wchar0 *out_str = STR0 (out);
cc724f2005-05-05Martin Nilsson  for(i=0; i < in->len;) {
57dd672005-04-02Martin Stjernholm  unsigned int c = STR0(in)[i++]; /* NOTE: No tests here since we've already tested the string above. */ if (c & 0x80) { /* 11bit */ unsigned int c2 = STR0(in)[i++] & 0x3f; c &= 0x1f; c = (c << 6) | c2; } out_str[j++] = c; } break; }
be40771998-10-15Henrik Grubbström (Grubba) 
57dd672005-04-02Martin Stjernholm  case 1: {
cfd6422005-04-02Martin Stjernholm  p_wchar1 *out_str = STR1 (out);
cc724f2005-05-05Martin Nilsson  for(i=0; i < in->len;) {
57dd672005-04-02Martin Stjernholm  unsigned int c = STR0(in)[i++]; /* NOTE: No tests here since we've already tested the string above. */ if (c & 0x80) { if ((c & 0xe0) == 0xc0) { /* 11bit */ unsigned int c2 = STR0(in)[i++] & 0x3f; c &= 0x1f; c = (c << 6) | c2; } else { /* 16bit */ unsigned int c2 = STR0(in)[i++] & 0x3f; unsigned int c3 = STR0(in)[i++] & 0x3f; c &= 0x0f; c = (c << 12) | (c2 << 6) | c3; } } out_str[j++] = c;
be40771998-10-15Henrik Grubbström (Grubba)  }
57dd672005-04-02Martin Stjernholm  break; } case 2: {
cfd6422005-04-02Martin Stjernholm  p_wchar2 *out_str = STR2 (out);
cc724f2005-05-05Martin Nilsson  for(i=0; i < in->len;) {
57dd672005-04-02Martin Stjernholm  unsigned int c = STR0(in)[i++]; /* NOTE: No tests here since we've already tested the string above. */ if (c & 0x80) { int cont = 0; 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 int c2 = STR0(in)[i++] & 0x3f; c = (c << 6) | c2; } } out_str[j++] = c;
be40771998-10-15Henrik Grubbström (Grubba)  }
57dd672005-04-02Martin Stjernholm  break;
be40771998-10-15Henrik Grubbström (Grubba)  } }
57dd672005-04-02Martin Stjernholm 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
be40771998-10-15Henrik Grubbström (Grubba)  if (j != len) {
2d76f22005-05-20Martin Stjernholm  Pike_fatal("utf8_to_string(): Calculated and actual lengths differ: " "%"PRINTPTRDIFFT"d != %"PRINTPTRDIFFT"d\n",
be40771998-10-15Henrik Grubbström (Grubba)  len, j); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
57dd672005-04-02Martin Stjernholm  out = low_end_shared_string(out);
cfd6422005-04-02Martin Stjernholm #ifdef PIKE_DEBUG check_string (out); #endif
be40771998-10-15Henrik Grubbström (Grubba)  pop_n_elems(args); push_string(out); }
f23c5d2007-06-02Martin Bähr /*! @decl string(0..255) __parse_pike_type(string(0..255) t)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
aa0bdf1999-11-08Per Hedbor static void f_parse_pike_type( INT32 args ) {
babd872001-02-23Henrik Grubbström (Grubba)  struct pike_type *t;
1f88bf2001-09-24Henrik Grubbström (Grubba) 
babd872001-02-23Henrik Grubbström (Grubba)  if( !args || Pike_sp[-1].type != T_STRING ||
edf4d02000-07-06Fredrik Hübinette (Hubbe)  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" );
babd872001-02-23Henrik Grubbström (Grubba)  t = parse_type( (char *)STR0(Pike_sp[-1].u.string) );
aa0bdf1999-11-08Per Hedbor  pop_stack();
babd872001-02-23Henrik Grubbström (Grubba) 
986b522001-03-17Henrik Grubbström (Grubba)  push_string(type_to_string(t)); free_type(t);
aa0bdf1999-11-08Per Hedbor }
cf27cc2007-04-20Henrik Grubbström (Grubba) /*! @decl type __soft_cast(type to, type from) *! *! Return the resulting type from a soft cast of @[from] to @[to]. */ static void f___soft_cast(INT32 args) { struct pike_type *res;
24adc72008-09-26Martin Nilsson  if (args < 2) Pike_error("Bad number of arguments to __soft_cast().\n");
cf27cc2007-04-20Henrik Grubbström (Grubba)  if (Pike_sp[-args].type != PIKE_T_TYPE) {
24adc72008-09-26Martin Nilsson  Pike_error("Bad argument 1 to __soft_cast() expected type.\n");
cf27cc2007-04-20Henrik Grubbström (Grubba)  } if (Pike_sp[1-args].type != PIKE_T_TYPE) {
24adc72008-09-26Martin Nilsson  Pike_error("Bad argument 2 to __soft_cast() expected type.\n");
cf27cc2007-04-20Henrik Grubbström (Grubba)  } if (!(res = soft_cast(Pike_sp[-args].u.type, Pike_sp[1-args].u.type, 0))) { pop_n_elems(args); push_undefined(); } else { pop_n_elems(args); push_type_value(res); } }
34d9b52007-03-29Henrik Grubbström (Grubba) /*! @decl type __low_check_call(type fun_type, type arg_type) *! @decl type __low_check_call(type fun_type, type arg_type, int flags)
44fe362007-03-26Henrik Grubbström (Grubba)  *! *! Check whether a function of type @[fun_type] may be called *! with a first argument of type @[arg_type]. *!
88d1952007-03-28Henrik Grubbström (Grubba)  *! @param flags *! The following flags are currently defined: *! @int *! @value 1 *! Strict types. Fail if not all possible values in @[arg_type] *! are valid as the first argument to @[fun_type]. *! @value 2 *! Last argument. @[arg_type] is the last argument to @[fun_type]. *! @value 3 *! Both strict types and last argument as above. *! @endint *!
44fe362007-03-26Henrik Grubbström (Grubba)  *! @returns *! Returns a continuation type on success. *! *! Returns @tt{0@} (zero) on failure. */
34d9b52007-03-29Henrik Grubbström (Grubba) static void f___low_check_call(INT32 args)
44fe362007-03-26Henrik Grubbström (Grubba) { struct pike_type *res;
88d1952007-03-28Henrik Grubbström (Grubba)  INT32 flags = 0;
9129122007-04-21Henrik Grubbström (Grubba)  struct svalue *sval = NULL;
34d9b52007-03-29Henrik Grubbström (Grubba)  if (args < 2) Pike_error("Bad number of arguments to __low_check_call().\n");
88d1952007-03-28Henrik Grubbström (Grubba)  if (Pike_sp[-args].type != PIKE_T_TYPE) {
34d9b52007-03-29Henrik Grubbström (Grubba)  Pike_error("Bad argument 1 to __low_check_call() expected type.\n");
44fe362007-03-26Henrik Grubbström (Grubba)  }
88d1952007-03-28Henrik Grubbström (Grubba)  if (Pike_sp[1-args].type != PIKE_T_TYPE) {
34d9b52007-03-29Henrik Grubbström (Grubba)  Pike_error("Bad argument 2 to __low_check_call() expected type.\n");
88d1952007-03-28Henrik Grubbström (Grubba)  } if (args > 2) { if (Pike_sp[2-args].type != PIKE_T_INT) {
34d9b52007-03-29Henrik Grubbström (Grubba)  Pike_error("Bad argument 3 to __low_check_call() expected int.\n");
88d1952007-03-28Henrik Grubbström (Grubba)  } flags = Pike_sp[2-args].u.integer;
44fe362007-03-26Henrik Grubbström (Grubba)  }
9129122007-04-21Henrik Grubbström (Grubba)  if (args > 3) sval = Pike_sp + 3 - args;
88d1952007-03-28Henrik Grubbström (Grubba)  if (!(res = low_new_check_call(Pike_sp[-args].u.type,
9129122007-04-21Henrik Grubbström (Grubba)  Pike_sp[1-args].u.type, flags, sval))) {
44fe362007-03-26Henrik Grubbström (Grubba)  pop_n_elems(args); push_undefined(); } else { pop_n_elems(args); push_type_value(res); } } /*! @decl type __get_return_type(type fun_type) *! *! Check what a function of the type @[fun_type] will *! return if called with no arguments. *! *! @returns *! Returns the type of the returned value on success *! *! Returns @tt{0@} (zero) on failure. */ static void f___get_return_type(INT32 args) { struct pike_type *res; if (args != 1) { Pike_error("Bad number of arguments to __get_return_type().\n"); } if (Pike_sp[-1].type != PIKE_T_TYPE) { Pike_error("Bad argument 1 to __get_return_type() expected type.\n"); } if (!(res = new_get_return_type(Pike_sp[-1].u.type, 0))) { pop_n_elems(args); push_undefined(); } else { pop_n_elems(args); push_type_value(res); } } /*! @decl type __get_first_arg_type(type fun_type) *! *! Check if a function of the type @[fun_type] may be called *! with an argument, and return the type of that argument. *! *! @returns *! Returns the expected type of the first argument to the function. *! *! Returns @tt{0@} (zero) if a function of the type @[fun_type] *! may not be called with any argument, or if it is not callable. */ static void f___get_first_arg_type(INT32 args) { struct pike_type *res; if (args != 1) { Pike_error("Bad number of arguments to __get_first_arg_type().\n"); } if (Pike_sp[-1].type != PIKE_T_TYPE) { Pike_error("Bad argument 1 to __get_first_arg_type() expected type.\n"); } if (!(res = get_first_arg_type(Pike_sp[-1].u.type, 0))) { pop_n_elems(args); push_undefined(); } else { pop_n_elems(args); push_type_value(res); } }
19febd2002-02-14Martin Nilsson /*! @decl mapping (string:mixed) all_constants()
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Returns a mapping containing all global constants, indexed on the name *! of the constant, and with the value of the constant as value.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[add_constant()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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) }
e290f32006-01-27Henrik Grubbström (Grubba) /*! @decl CompilationHandler get_active_compilation_handler()
5671ce2006-01-26Henrik Grubbström (Grubba)  *! *! Returns the currently active compilation compatibility handler, or *! @tt{0@} (zero) if none is active. *! *! @note *! This function should only be used during a call of @[compile()]. *! *! @seealso *! @[get_active_error_handler()], @[compile()],
e290f32006-01-27Henrik Grubbström (Grubba)  *! @[master()->get_compilation_handler()], @[CompilationHandler]
5671ce2006-01-26Henrik Grubbström (Grubba)  */ PMOD_EXPORT void f_get_active_compilation_handler(INT32 args) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = NULL; if (compilation_program) { struct pike_frame *compiler_frame = Pike_fp; while (compiler_frame && (compiler_frame->context->prog != compilation_program)) { compiler_frame = compiler_frame->next; } if (compiler_frame) { c = (struct compilation *)compiler_frame->current_storage; } }
5671ce2006-01-26Henrik Grubbström (Grubba)  pop_n_elems(args);
e021fe2008-04-14Henrik Grubbström (Grubba)  if (c && c->compat_handler) { ref_push_object(c->compat_handler);
5671ce2006-01-26Henrik Grubbström (Grubba)  } else { push_int(0); } }
e290f32006-01-27Henrik Grubbström (Grubba) /*! @decl CompilationHandler get_active_error_handler()
5671ce2006-01-26Henrik Grubbström (Grubba)  *! *! Returns the currently active compilation error handler
e290f32006-01-27Henrik Grubbström (Grubba)  *! (second argument to @[compile()]), or @tt{0@} (zero) if none
5671ce2006-01-26Henrik Grubbström (Grubba)  *! is active. *! *! @note *! This function should only be used during a call of @[compile()]. *! *! @seealso
e290f32006-01-27Henrik Grubbström (Grubba)  *! @[get_active_compilation_handler()], @[compile()], @[CompilationHandler]
5671ce2006-01-26Henrik Grubbström (Grubba)  */ PMOD_EXPORT void f_get_active_error_handler(INT32 args) {
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = NULL; if (compilation_program) { struct pike_frame *compiler_frame = Pike_fp; while (compiler_frame && (compiler_frame->context->prog != compilation_program)) { compiler_frame = compiler_frame->next; } if (compiler_frame) { c = (struct compilation *)compiler_frame->current_storage; } }
5671ce2006-01-26Henrik Grubbström (Grubba)  pop_n_elems(args);
e021fe2008-04-14Henrik Grubbström (Grubba)  if (c && c->handler) { ref_push_object(c->handler);
5671ce2006-01-26Henrik Grubbström (Grubba)  } else { push_int(0); } }
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl array allocate(int size)
2523ce2003-04-28Martin Stjernholm  *! @decl array allocate(int size, mixed init)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
2523ce2003-04-28Martin Stjernholm  *! Allocate an array of @[size] elements. If @[init] is specified *! then each element is initialized by copying that value *! recursively.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[sizeof()], @[aggregate()], @[arrayp()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_allocate(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
3ee2a62004-11-14Alexander Demenshin  INT_TYPE size;
8267f41998-01-28Fredrik Hübinette (Hubbe)  struct array *a;
87a3422004-05-13Martin Nilsson  struct svalue *init;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
87a3422004-05-13Martin Nilsson  get_all_args("allocate", args, "%+.%*", &size, &init);
2cff8d2004-11-14Martin Stjernholm  if (size > MAX_INT32) SIMPLE_ARG_ERROR ("allocate", 1, "Integer too large to use as array size.");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
8267f41998-01-28Fredrik Hübinette (Hubbe)  a=allocate_array(size); if(args>1) { INT32 e;
2523ce2003-04-28Martin Stjernholm  push_array (a);
87a3422004-05-13Martin Nilsson  for(e=0;e<size;e++)
2523ce2003-04-28Martin Stjernholm  copy_svalues_recursively_no_free(a->item+e, init, 1, 0); a->type_field = 1 << init->type; stack_pop_n_elems_keep_top (args); } else { a->type_field = BIT_INT; pop_n_elems(args); push_array(a);
8267f41998-01-28Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
0ee38f2002-05-11Martin Stjernholm /*! @decl object this_object(void|int level);
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Returns the object we are currently evaluating in.
0ee38f2002-05-11Martin Stjernholm  *! *! @[level] might be used to access the object of a surrounding *! class: The object at level 0 is the current object, the object
aa7e422003-08-03Martin Stjernholm  *! at level 1 is the one belonging to the class that surrounds *! the class that the object comes from, and so on. *! *! @note *! As opposed to a qualified @expr{this@} reference such as *! @expr{global::this@}, this function doesn't always access the *! objects belonging to the lexically surrounding classes. If the *! class containing the call has been inherited then the objects *! surrounding the inheriting class are accessed.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_this_object(INT32 args) {
aa7e422003-08-03Martin Stjernholm  int level, l; struct object *o;
0ee38f2002-05-11Martin Stjernholm  if (args) { if (Pike_sp[-args].type != T_INT || Pike_sp[-args].u.integer < 0) SIMPLE_BAD_ARG_ERROR ("this_object", 1, "a non-negative integer"); level = Pike_sp[-args].u.integer; } else level = 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args);
aa7e422003-08-03Martin Stjernholm  o = Pike_fp->current_object; for (l = 0; l < level; l++) { struct program *p = o->prog; if (!p) Pike_error ("Object %d level(s) up is destructed - cannot get the parent.\n", l); if (!(p->flags & PROGRAM_USES_PARENT)) /* FIXME: Ought to write out the object here. */ Pike_error ("Object %d level(s) up lacks parent reference.\n", l); o = PARENT_INFO(o)->parent;
cb22561995-10-11Fredrik Hübinette (Hubbe)  }
aa7e422003-08-03Martin Stjernholm  ref_push_object(o);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
0ee38f2002-05-11Martin Stjernholm static node *optimize_this_object(node *n)
b62ab01999-12-12Henrik Grubbström (Grubba) {
aa7e422003-08-03Martin Stjernholm  int level = 0;
0ee38f2002-05-11Martin Stjernholm  if (CDR (n)) {
8853882008-04-26Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION;
0ee38f2002-05-11Martin Stjernholm  struct program_state *state = Pike_compiler;
8853882008-04-26Henrik Grubbström (Grubba)  CHECK_COMPILER();
0ee38f2002-05-11Martin Stjernholm  if (CDR (n)->token != F_CONSTANT) { /* Not a constant expression. Make sure there are parent * pointers all the way. */ int i;
8853882008-04-26Henrik Grubbström (Grubba)  for (i = 0; i < c->compilation_depth; i++, state = state->previous)
0ee38f2002-05-11Martin Stjernholm  state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT; return NULL; } else {
aa7e422003-08-03Martin Stjernholm  int i;
0ee38f2002-05-11Martin Stjernholm #ifdef PIKE_DEBUG if (CDR (n)->u.sval.type != T_INT || CDR (n)->u.sval.u.integer < 0)
5aad932002-08-15Marcus Comstedt  Pike_fatal ("The type check for this_object() failed.\n");
0ee38f2002-05-11Martin Stjernholm #endif level = CDR (n)->u.sval.u.integer;
8853882008-04-26Henrik Grubbström (Grubba)  for (i = MINIMUM(level, c->compilation_depth); i;
073ccf2003-08-04Henrik Grubbström (Grubba)  i--, state = state->previous) { state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT; }
0ee38f2002-05-11Martin Stjernholm  } }
aa7e422003-08-03Martin Stjernholm  /* We can only improve the type when accessing the innermost object: * Since this_object always follows the object pointers it might not * access the lexically surrounding objects. Thus the * PROGRAM_USES_PARENT stuff above is a bit of a long shot, but it's * better than nothing. */ if (!level) { free_type(n->type); type_stack_mark(); /* We are rather sure that we contain ourselves... */ /* push_object_type(1, Pike_compiler->new_program->id); */ /* But it did not work yet, so... */ push_object_type(0, Pike_compiler->new_program->id); n->type = pop_unfinished_type(); if (n->parent) { n->parent->node_info |= OPT_TYPE_NOT_FIXED; }
b62ab01999-12-12Henrik Grubbström (Grubba)  }
aa7e422003-08-03Martin Stjernholm 
b62ab01999-12-12Henrik Grubbström (Grubba)  return NULL; }
0811472001-07-02Fredrik Hübinette (Hubbe) static int generate_this_object(node *n) {
0ee38f2002-05-11Martin Stjernholm  int level;
e021fe2008-04-14Henrik Grubbström (Grubba)  struct compilation *c = THIS_COMPILATION; CHECK_COMPILER();
0ee38f2002-05-11Martin Stjernholm  if (CDR (n)) { if (CDR (n)->token != F_CONSTANT) /* Not a constant expression. Make a call to f_this_object. */ return 0; else { #ifdef PIKE_DEBUG if (CDR (n)->u.sval.type != T_INT || CDR (n)->u.sval.u.integer < 0)
5aad932002-08-15Marcus Comstedt  Pike_fatal ("The type check for this_object() failed.\n");
0ee38f2002-05-11Martin Stjernholm #endif level = CDR (n)->u.sval.u.integer; } } else level = 0; emit1(F_THIS_OBJECT, level);
384f222008-08-28Henrik Grubbström (Grubba)  modify_stack_depth(1);
0811472001-07-02Fredrik Hübinette (Hubbe)  return 1; }
bf5cbe2005-02-18Henrik Grubbström (Grubba) /*! @decl mixed|void throw(mixed value)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Throw @[value] to a waiting @[catch].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! If no @[catch] is waiting the global error handling will send the *! value to @[master()->handle_error()].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[catch]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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) }
ba58572008-07-09Henrik Grubbström (Grubba) int in_forked_child = 0;
19e2c32004-03-02Martin Nilsson /*! @decl void exit(int returncode, void|string fmt, mixed ... extra)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Exit the whole Pike program with the given @[returncode].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! Using @[exit()] with any other value than @expr{0@} (zero) indicates *! that something went wrong during execution. See your system manuals *! for more information about return codes.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
b5ef7d2004-01-11Martin Nilsson  *! The arguments after the @[returncode] will be used for a call to *! @[werror] to output a message on stderr. *!
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[_exit()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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;
8111162003-09-07Martin Nilsson  ASSERT_SECURITY_ROOT("exit");
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;
d8e90a2004-05-09Martin Nilsson  if(args>1 && Pike_sp[1-args].type==T_STRING) {
ea84872007-01-15Henrik Grubbström (Grubba)  struct svalue *s = simple_mapping_string_lookup(get_builtin_constants(), "werror"); if (s) { apply_svalue(s, args-1); pop_stack();
7f69142007-01-15Henrik Grubbström (Grubba)  } else {
ea84872007-01-15Henrik Grubbström (Grubba)  fprintf(stderr, "No efun::werror() at exit.\n"); pop_n_elems(args-1); }
d8e90a2004-05-09Martin Nilsson  args=1; }
b5ef7d2004-01-11Martin Nilsson 
ba58572008-07-09Henrik Grubbström (Grubba)  if (in_forked_child) { /* Don't bother to clean up if we're running in a forked child. */ f__exit(args); }
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) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Use with extreme caution.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[exit()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
608d731998-03-20Fredrik Hübinette (Hubbe) void f__exit(INT32 args) {
b2acc92004-05-13Martin Nilsson  int code;
8111162003-09-07Martin Nilsson  ASSERT_SECURITY_ROOT("_exit");
d9ed862005-11-19Henrik Grubbström (Grubba)  get_all_args("_exit", args, "%d", &code);
608d731998-03-20Fredrik Hübinette (Hubbe) 
d9a93b2001-07-01Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG { /* This will allow -p to work with _exit -Hubbe */
143d882003-11-14Martin Stjernholm  exit_opcodes();
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  } #endif
ba58572008-07-09Henrik Grubbström (Grubba)  /* FIXME: Shouldn't _exit(2) be called here? */
b2acc92004-05-13Martin Nilsson  exit(code);
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) *!
df0f872003-04-14Martin Stjernholm  *! This function returns the number of seconds since 00:00:00 UTC, 1 Jan 1970.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
93af2d2003-10-31Martin Stjernholm  *! The second syntax does not query the system for the current *! time. Instead the latest done by the pike process is returned *! again. That's slightly faster but can be wildly inaccurate. Pike *! queries the time internally when a thread has waited for *! something, typically in @[sleep] or in a backend (see *! @[Pike.Backend]).
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
5ef9052003-01-13Martin Stjernholm  *! @[ctime()], @[localtime()], @[mktime()], @[gmtime()],
2cccd32003-01-13Martin Stjernholm  *! @[System.gettimeofday], @[gethrtime]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_time(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
9ef11f2006-01-11Martin Stjernholm  if(!args || (Pike_sp[-args].type == T_INT && Pike_sp[-args].u.integer == 0))
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) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function crypts and verifies a short string (only the first *! 8 characters are significant).
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! The first syntax crypts the string @[password] into something that *! is hopefully hard to decrypt.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! The second syntax is used to verify @[typed_password] against
cbe8c92003-04-07Martin Nilsson  *! @[crypted_password], and returns @expr{1@} if they match, and *! @expr{0@} (zero) otherwise.
b2acc92004-05-13Martin Nilsson  *! *! @note *! Note that strings containing null characters will only be *! processed up until the null character.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_crypt(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { char salt[2];
b2acc92004-05-13Martin Nilsson  char *ret, *pwd, *saltp;
5267b71995-08-09Fredrik Hübinette (Hubbe)  char *choise = "cbhisjKlm4k65p7qrJfLMNQOPxwzyAaBDFgnoWXYCZ0123tvdHueEGISRTUV89./";
b2acc92004-05-13Martin Nilsson  get_all_args("crypt", args, "%s.%s", &pwd, &saltp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args>1) {
b2acc92004-05-13Martin Nilsson  if( 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)  } 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
b2acc92004-05-13Martin Nilsson  ret = (char *)crypt(pwd, saltp);
5267b71995-08-09Fredrik Hübinette (Hubbe) #else #ifdef HAVE__CRYPT
b2acc92004-05-13Martin Nilsson  ret = (char *)_crypt(pwd, saltp);
5267b71995-08-09Fredrik Hübinette (Hubbe) #else
24adc72008-09-26Martin Nilsson #error No crypt function found and fallback failed.
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif #endif if(args < 2) { pop_n_elems(args);
f0e6f12003-12-06Martin Nilsson  push_text(ret);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{ int i;
b2acc92004-05-13Martin Nilsson  i=!strcmp(ret,saltp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(i); } }
c8bb3c2004-04-20Martin Nilsson /*! @decl void destruct(void|object o)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Mark an object as destructed.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
c8bb3c2004-04-20Martin Nilsson  *! Calls @expr{o->destroy()@}, and then clears all variables in the *! object. If no argument is given, the current object is destructed.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! All pointers and function pointers to this object will become zero. *! The destructed object will be freed from memory as soon as possible.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_destruct(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct object *o; if(args) {
b5d71b2001-06-09Henrik Grubbström (Grubba)  if(Pike_sp[-args].type != T_OBJECT) { if ((Pike_sp[-args].type == T_INT) && (!Pike_sp[-args].u.integer)) { pop_n_elems(args); return; }
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_BAD_ARG_ERROR("destruct", 1, "object");
b5d71b2001-06-09Henrik Grubbström (Grubba)  }
e99c7a1999-10-29Martin Stjernholm 
edf4d02000-07-06Fredrik Hübinette (Hubbe)  o=Pike_sp[-args].u.object;
cb22561995-10-11Fredrik Hübinette (Hubbe)  }else{
b5d71b2001-06-09Henrik Grubbström (Grubba)  if(!Pike_fp) { PIKE_ERROR("destruct", "Destruct called without argument from callback function.\n", Pike_sp, args); }
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)
b5d71b2001-06-09Henrik Grubbström (Grubba)  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
54717e2001-06-28Fredrik Hübinette (Hubbe)  debug_malloc_touch(o);
09f2882005-02-09Martin Stjernholm  destruct_object (o, DESTRUCT_EXPLICIT);
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) }
937c462001-02-06Henrik Grubbström (Grubba) /*! @decl array indices(string|array|mapping|multiset|object x)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Return an array of all valid indices for the value @[x].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
b2acc92004-05-13Martin Nilsson  *! For strings and arrays this is simply an array of ascending *! numbers.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
30c0612008-06-29Martin Stjernholm  *! For mappings and multisets, the array might contain any value.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
b2acc92004-05-13Martin Nilsson  *! For objects which define @[lfun::_indices()] that return value
30c0612008-06-29Martin Stjernholm  *! is used.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
30c0612008-06-29Martin Stjernholm  *! For other objects an array with all non-protected symbols is
b2acc92004-05-13Martin Nilsson  *! returned.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[values()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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)  {
2523ce2003-04-28Martin Stjernholm  /* Elements are already integers. */
63540d2000-08-15Henrik Grubbström (Grubba)  ITEM(a)[size].u.integer = DO_NOT_WARN((INT_TYPE)size);
99946c1996-02-17Fredrik Hübinette (Hubbe)  }
2523ce2003-04-28Martin Stjernholm  a->type_field = BIT_INT;
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:
5b15bb2001-12-10Martin Stjernholm  a = multiset_indices (Pike_sp[-args].u.multiset);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
6d4c4c1995-11-06Fredrik Hübinette (Hubbe)  case T_OBJECT:
9273742008-05-29Henrik Grubbström (Grubba)  a=object_indices(Pike_sp[-args].u.object, Pike_sp[-args].subtype);
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); }
babd872001-02-23Henrik Grubbström (Grubba) /* this should probably be moved to pike_types.c or something */
4d7b181999-12-07Fredrik Hübinette (Hubbe) #define FIX_OVERLOADED_TYPE(n, lf, X) fix_overloaded_type(n,lf,X,CONSTANT_STRLEN(X))
ac04552001-02-20Henrik Grubbström (Grubba) /* FIXME: This function messes around with the implementation of pike_type, * and should probably be in pike_types.h instead. */
4d7b181999-12-07Fredrik Hübinette (Hubbe) static node *fix_overloaded_type(node *n, int lfun, const char *deftype, int deftypelen) { node **first_arg;
ac04552001-02-20Henrik Grubbström (Grubba)  struct pike_type *t, *t2;
4d7b181999-12-07Fredrik Hübinette (Hubbe)  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)) {
54f8ac2001-03-17Henrik Grubbström (Grubba)  /* Skip any name-nodes. */ while(t && t->type == PIKE_T_NAME) { t = t->cdr; }
3913502002-06-25Henrik Grubbström (Grubba) 
54f8ac2001-03-17Henrik Grubbström (Grubba)  /* FIXME: Ought to handle or-nodes here. */
3913502002-06-25Henrik Grubbström (Grubba)  if(t && (t->type == T_OBJECT))
4d7b181999-12-07Fredrik Hübinette (Hubbe)  {
d2361e2003-06-30Martin Stjernholm  struct program *p = id_to_program(CDR_TO_INT(t));
4d7b181999-12-07Fredrik Hübinette (Hubbe)  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 &&
babd872001-02-23Henrik Grubbström (Grubba)  (t2 = check_call(function_type_string, ID_FROM_INT(p, fun)->type, 0)))
4d7b181999-12-07Fredrik Hübinette (Hubbe)  {
d68a072001-02-20Henrik Grubbström (Grubba)  free_type(n->type);
babd872001-02-23Henrik Grubbström (Grubba)  n->type = t2;
4d7b181999-12-07Fredrik Hübinette (Hubbe)  return 0; } } } /* If it is an object, it *may* be overloaded, we or with * the deftype.... */ #if 1 if(deftype) {
8a2a522001-03-03Henrik Grubbström (Grubba)  t2 = make_pike_type(deftype);
babd872001-02-23Henrik Grubbström (Grubba)  t = n->type; n->type = or_pike_types(t,t2,0);
d68a072001-02-20Henrik Grubbström (Grubba)  free_type(t); free_type(t2);
4d7b181999-12-07Fredrik Hübinette (Hubbe)  } #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) {
d68a072001-02-20Henrik Grubbström (Grubba)  struct pike_type *types[2] = { NULL, NULL };
aab8411999-12-07Henrik Grubbström (Grubba)  node *args = CDR(n);
d68a072001-02-20Henrik Grubbström (Grubba)  struct pike_type *new_type = NULL;
aab8411999-12-07Henrik Grubbström (Grubba)  #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() */
babd872001-02-23Henrik Grubbström (Grubba)  /* FIXME: */
8a2a522001-03-03Henrik Grubbström (Grubba)  MAKE_CONSTANT_TYPE(new_type, tMap(tMixed, tMixed));
aab8411999-12-07Henrik Grubbström (Grubba)  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]) {
ac04552001-02-20Henrik Grubbström (Grubba)  struct pike_type *t = or_pike_types(types[argno], arg->type, 0);
d68a072001-02-20Henrik Grubbström (Grubba)  free_type(types[argno]);
f01a891999-12-08Henrik Grubbström (Grubba)  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 {
be6fec2001-04-01Henrik Grubbström (Grubba)  copy_pike_type(types[argno], arg->type);
f01a891999-12-08Henrik Grubbström (Grubba)  } 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]) {
8a2a522001-03-03Henrik Grubbström (Grubba)  MAKE_CONSTANT_TYPE(new_type, tMap(tZero, tZero));
aab8411999-12-07Henrik Grubbström (Grubba)  goto set_type; } type_stack_mark();
d68a072001-02-20Henrik Grubbström (Grubba)  push_finished_type(types[1]); push_finished_type(types[0]);
aab8411999-12-07Henrik Grubbström (Grubba)  push_type(T_MAPPING); new_type = pop_unfinished_type(); } else {
8a2a522001-03-03Henrik Grubbström (Grubba)  MAKE_CONSTANT_TYPE(new_type, tMap(tZero, tZero));
aab8411999-12-07Henrik Grubbström (Grubba)  goto set_type; } if (new_type) { set_type:
d68a072001-02-20Henrik Grubbström (Grubba)  free_type(n->type);
aab8411999-12-07Henrik Grubbström (Grubba)  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]) {
d68a072001-02-20Henrik Grubbström (Grubba)  free_type(types[1]);
aab8411999-12-07Henrik Grubbström (Grubba)  } if (types[0]) {
d68a072001-02-20Henrik Grubbström (Grubba)  free_type(types[0]);
aab8411999-12-07Henrik Grubbström (Grubba)  } return NULL; }
937c462001-02-06Henrik Grubbström (Grubba) /*! @decl array values(string|array|mapping|multiset|object x)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
b2acc92004-05-13Martin Nilsson  *! Return an array of all possible values from indexing the value *! @[x].
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
b2acc92004-05-13Martin Nilsson  *! For strings an array of int with the ISO10646 codes of the *! characters in the string is returned.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
b2acc92004-05-13Martin Nilsson  *! For a multiset an array filled with ones (@expr{1@}) is *! returned.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! For arrays a single-level copy of @[x] is returned.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! For mappings the array may contain any value.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
b2acc92004-05-13Martin Nilsson  *! For objects which define @[lfun::_values()] that return value
30c0612008-06-29Martin Stjernholm  *! is used.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
30c0612008-06-29Martin Stjernholm  *! For other objects an array with the values of all non-protected *! symbols is returned.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[indices()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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)  {
2523ce2003-04-28Martin Stjernholm  /* Elements are already integers. */
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)  }
2523ce2003-04-28Martin Stjernholm  a->type_field = BIT_INT;
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:
5b15bb2001-12-10Martin Stjernholm  a = multiset_values (Pike_sp[-args].u.multiset);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
6d4c4c1995-11-06Fredrik Hübinette (Hubbe)  case T_OBJECT:
9273742008-05-29Henrik Grubbström (Grubba)  a=object_values(Pike_sp[-args].u.object, Pike_sp[-args].subtype);
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() *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Returns the next object from the list of all objects.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! All objects are stored in a linked list. *! *! @returns *! If no arguments have been given @[next_object()] will return the first *! object from the list.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! If @[o] has been specified the object after @[o] on the list will be *! returned.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! This function is not recomended to use.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[destruct()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_next_object(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct object *o;
615b3e2003-01-28Martin Stjernholm 
8111162003-09-07Martin Nilsson  ASSERT_SECURITY_ROOT("next_object");
615b3e2003-01-28Martin Stjernholm 
5267b71995-08-09Fredrik Hübinette (Hubbe)  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)  } }
fd25e02003-04-27Martin Nilsson /*! @decl program|function object_program(mixed o)
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
fd25e02003-04-27Martin Nilsson  *! Return the program from which @[o] was instantiated. If the
f3f0e82003-04-27Henrik Grubbström (Grubba)  *! object was instantiated from a class using parent references *! the generating function will be returned.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! If @[o] is not an object or has been destructed @expr{0@} (zero)
554e222001-05-06Henrik Grubbström (Grubba)  *! will be returned.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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;
c07fe52003-01-16Martin Stjernholm  struct program *p = o->prog; #if 0 /* This'd be nice, but it doesn't work well since the returned * function can't double as a program (program_from_svalue returns * NULL for it). */ if (p == pike_trampoline_program) { struct pike_trampoline *t = (struct pike_trampoline *) o->storage; if (t->frame && t->frame->current_object) { add_ref (o = t->frame->current_object); pop_n_elems (args); push_function (o, t->func); return; } } #endif if(p)
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  {
d22ebc2008-05-28Henrik Grubbström (Grubba)  if (Pike_sp[-args].subtype) { /* FIXME: This probably works for the subtype-less case as well. */ struct external_variable_context loc; loc.o = o; p = (loc.inherit = p->inherits + Pike_sp[-args].subtype)->prog; if (p->flags & PROGRAM_USES_PARENT) { loc.parent_identifier = loc.inherit->parent_identifier; find_external_context(&loc, 1); add_ref(loc.o); pop_n_elems(args); push_function(loc.o, loc.parent_identifier); return; } } else if((p->flags & PROGRAM_USES_PARENT) &&
f3c7152001-04-14Fredrik Hübinette (Hubbe)  PARENT_INFO(o)->parent && PARENT_INFO(o)->parent->prog)
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  {
f3c7152001-04-14Fredrik Hübinette (Hubbe)  INT32 id=PARENT_INFO(o)->parent_identifier; o=PARENT_INFO(o)->parent;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(o);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  pop_n_elems(args);
c07fe52003-01-16Martin Stjernholm  push_function(o, id);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  return; }
d22ebc2008-05-28Henrik Grubbström (Grubba)  add_ref(p); pop_n_elems(args); push_program(p); return;
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  }
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;
ac04552001-02-20Henrik Grubbström (Grubba)  struct pike_type *new_type = NULL;
70c9261999-12-22Henrik Grubbström (Grubba)  if (!n->type) {
be6fec2001-04-01Henrik Grubbström (Grubba)  copy_pike_type(n->type, program_type_string);
70c9261999-12-22Henrik Grubbström (Grubba)  } 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) {
d68a072001-02-20Henrik Grubbström (Grubba)  free_type(n->type);
70c9261999-12-22Henrik Grubbström (Grubba)  n->type = new_type; } return NULL; }
2b888e2008-01-29Henrik Grubbström (Grubba) /*! @decl string reverse(string s, int|void start, int|void end) *! @decl array reverse(array a, int|void start, int|void end) *! @decl int reverse(int i, int|void start, int|void end)
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Reverses a string, array or int.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
2b888e2008-01-29Henrik Grubbström (Grubba)  *! @param s *! String to reverse. *! @param a *! Array to reverse. *! @param i *! Integer to reverse. *! @param start *! Optional start index of the range to reverse. *! Default: @expr{0@} (zero). *! @param end *! Optional end index of the range to reverse. *! Default for strings: @expr{sizeof(s)-1@}. *! Default for arrays: @expr{sizeof(a)-1@}. *! Default for integers: @expr{Pike.get_runtime_info()->int_size - 1@}. *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function reverses a string, char by char, an array, value
5b916d2002-09-29Martin Stjernholm  *! by value or an int, bit by bit and returns the result. It's not *! destructive on the input value.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Reversing strings can be particularly useful for parsing difficult *! syntaxes which require scanning backwards.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[sscanf()]
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_reverse(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
2b888e2008-01-29Henrik Grubbström (Grubba)  struct svalue *sv; int start = 0, end = -1;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
2b888e2008-01-29Henrik Grubbström (Grubba)  get_all_args("reverse", args, "%*.%d%d", &sv, &start, &end); switch(sv->type)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { case T_STRING: { INT32 e;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s;
0ede072008-08-22Henrik Grubbström (Grubba)  struct pike_string *orig = sv->u.string;;
2b888e2008-01-29Henrik Grubbström (Grubba)  if (start < 0) { start = 0;
0ede072008-08-22Henrik Grubbström (Grubba)  } else if (start >= orig->len) {
2b888e2008-01-29Henrik Grubbström (Grubba)  /* Noop. */ pop_n_elems(args-1); break; }
0ede072008-08-22Henrik Grubbström (Grubba)  if ((end < 0) || (end >= orig->len)) { end = orig->len;
2b888e2008-01-29Henrik Grubbström (Grubba)  } else if (end <= start) { /* Noop. */ pop_n_elems(args-1); break; } else { end++; }
0ede072008-08-22Henrik Grubbström (Grubba)  s=begin_wide_shared_string(orig->len, orig->size_shift); if ((orig->len << orig->size_shift) >= 524288) { /* More than 512KB. Release the interpreter lock. */ THREADS_ALLOW(); switch(orig->size_shift) { case 0: for(e=0;e<start;e++) STR0(s)[e]=STR0(orig)[e]; for(;e<end;e++) STR0(s)[e]=STR0(orig)[end-1-e-start]; for(;e<orig->len;e++) STR0(s)[e]=STR0(orig)[e]; break; case 1: for(e=0;e<start;e++) STR1(s)[e]=STR1(orig)[e]; for(;e<end;e++) STR1(s)[e]=STR1(orig)[end-1-e-start]; for(;e<orig->len;e++) STR1(s)[e]=STR1(orig)[e]; break; case 2: for(e=0;e<start;e++) STR2(s)[e]=STR2(orig)[e]; for(;e<end;e++) STR2(s)[e]=STR2(orig)[end-1-e-start]; for(;e<orig->len;e++) STR2(s)[e]=STR2(orig)[e]; break; } THREADS_DISALLOW(); } else { switch(orig->size_shift) {
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  case 0:
2b888e2008-01-29Henrik Grubbström (Grubba)  for(e=0;e<start;e++)
0ede072008-08-22Henrik Grubbström (Grubba)  STR0(s)[e]=STR0(orig)[e];
2b888e2008-01-29Henrik Grubbström (Grubba)  for(;e<end;e++)
0ede072008-08-22Henrik Grubbström (Grubba)  STR0(s)[e]=STR0(orig)[end-1-e-start]; for(;e<orig->len;e++) STR0(s)[e]=STR0(orig)[e];
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break; case 1:
2b888e2008-01-29Henrik Grubbström (Grubba)  for(e=0;e<start;e++)
0ede072008-08-22Henrik Grubbström (Grubba)  STR1(s)[e]=STR1(orig)[e];
2b888e2008-01-29Henrik Grubbström (Grubba)  for(;e<end;e++)
0ede072008-08-22Henrik Grubbström (Grubba)  STR1(s)[e]=STR1(orig)[end-1-e-start]; for(;e<orig->len;e++) STR1(s)[e]=STR1(orig)[e];
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break; case 2:
2b888e2008-01-29Henrik Grubbström (Grubba)  for(e=0;e<start;e++)
0ede072008-08-22Henrik Grubbström (Grubba)  STR2(s)[e]=STR2(orig)[e];
2b888e2008-01-29Henrik Grubbström (Grubba)  for(;e<end;e++)
0ede072008-08-22Henrik Grubbström (Grubba)  STR2(s)[e]=STR2(orig)[end-1-e-start]; for(;e<orig->len;e++) STR2(s)[e]=STR2(orig)[e];
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  break;
0ede072008-08-22Henrik Grubbström (Grubba)  }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  } s=low_end_shared_string(s);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(s); break; } case T_INT: {
2b888e2008-01-29Henrik Grubbström (Grubba)  /* FIXME: Ought to use INT_TYPE! */
5267b71995-08-09Fredrik Hübinette (Hubbe)  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; }
a63b362003-11-07Martin Stjernholm  /* FIXME: Bignum support. */
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_ARRAY: {
2b888e2008-01-29Henrik Grubbström (Grubba)  struct array *a = sv->u.array; a = reverse_array(a, start, (end < 0)?a->size:end);
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)  } }
7e97c31999-01-21Fredrik Hübinette (Hubbe) /* Magic, magic and more magic */
3f268a2006-03-09Henrik Grubbström (Grubba) /* Returns the index in v for the string that is the longest prefix of * str (if any). * * v is the sorted (according to generic_quick_binary_strcmp()) vector * of replacement strings. It also has the prefix forest identified. * * a is the lower bound. * b is the upper bound + 1. */
dc384d2006-03-11Henrik Grubbström (Grubba) int find_longest_prefix(char *str, ptrdiff_t len, int size_shift, struct replace_many_tupel *v, INT32 a, INT32 b)
7e97c31999-01-21Fredrik Hübinette (Hubbe) {
66096f2008-07-04Martin Stjernholm  INT32 c, match=-1, match_len=-1;
93b7202000-08-14Henrik Grubbström (Grubba)  ptrdiff_t tmp;
0fe6702004-04-30Martin Stjernholm  check_c_stack(2048);
7e97c31999-01-21Fredrik Hübinette (Hubbe)  while(a<b) { c=(a+b)/2;
3f268a2006-03-09Henrik Grubbström (Grubba) 
24e45c2006-03-11Henrik Grubbström (Grubba)  if (v[c].ind->len <= match_len) { /* Can't be a suffix of (or is equal to) the current match. */ b = c; continue; }
18d9352006-03-10Henrik Grubbström (Grubba)  tmp=generic_find_binary_prefix(v[c].ind->str, v[c].ind->len, v[c].ind->size_shift, str, MINIMUM(len,v[c].ind->len), size_shift);
d8fc6f2006-03-10Henrik Grubbström (Grubba) 
7e97c31999-01-21Fredrik Hübinette (Hubbe)  if(tmp<0) {
18d9352006-03-10Henrik Grubbström (Grubba)  /* Check if we might have a valid prefix that is better than * the current match. */ if (~tmp > match_len) {
3f268a2006-03-09Henrik Grubbström (Grubba)  /* We need to look closer to see if we might have a partial prefix. */ int d = c;
18d9352006-03-10Henrik Grubbström (Grubba)  tmp = -tmp; while (((d = v[d].prefix) >= a) && (v[d].ind->len > match_len)) { if (v[d].ind->len < tmp) {
3f268a2006-03-09Henrik Grubbström (Grubba)  /* Found a valid prefix. */ match = d; match_len = v[d].ind->len; break; }
7e97c31999-01-21Fredrik Hübinette (Hubbe)  } }
3f268a2006-03-09Henrik Grubbström (Grubba)  a = c+1;
7e97c31999-01-21Fredrik Hübinette (Hubbe)  } else if(tmp>0) { b=c;
28ab942006-03-13Henrik Grubbström (Grubba)  while ((c = v[b].prefix) > a) { if (v[c].ind->len < tmp) { if (v[c].ind->len > match_len) { match = c; match_len = v[c].ind->len; } a = c+1; break; } b = c; }
7e97c31999-01-21Fredrik Hübinette (Hubbe)  } else {
24e45c2006-03-11Henrik Grubbström (Grubba)  if (!v[c].is_prefix) { return c; }
7e97c31999-01-21Fredrik Hübinette (Hubbe)  a=c+1; /* There might still be a better match... */ match=c;
3f268a2006-03-09Henrik Grubbström (Grubba)  match_len = v[c].ind->len;
7e97c31999-01-21Fredrik Hübinette (Hubbe)  } } return match; }
dc384d2006-03-11Henrik Grubbström (Grubba) static int replace_sortfun(struct replace_many_tupel *a, struct replace_many_tupel *b)
70da5a2001-06-27Henrik Grubbström (Grubba) { return DO_NOT_WARN((int)my_quick_strcmp(a->ind, b->ind)); }
dc384d2006-03-11Henrik Grubbström (Grubba) void free_replace_many_context(struct replace_many_context *ctx)
0fe6702004-04-30Martin Stjernholm {
dc384d2006-03-11Henrik Grubbström (Grubba)  if (ctx->v) { if (ctx->flags) { /* Used for the precompiled case. */ int e = ctx->num; while (e--) { free_string(ctx->v[e].ind); free_string(ctx->v[e].val); } if (ctx->empty_repl) { free_string(ctx->empty_repl); } } free ((char *) ctx->v); ctx->v = NULL; }
0fe6702004-04-30Martin Stjernholm }
dc384d2006-03-11Henrik Grubbström (Grubba) void compile_replace_many(struct replace_many_context *ctx, struct array *from, struct array *to, int reference_strings)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
3f268a2006-03-09Henrik Grubbström (Grubba)  INT32 e, num;
a8cdf92004-04-29Martin Nilsson 
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->v = NULL; ctx->empty_repl = NULL;
7f0f342006-03-09Henrik Grubbström (Grubba) 
652b672008-05-01Martin Stjernholm #if INT32_MAX >= LONG_MAX
99e4f02004-10-15Henrik Grubbström (Grubba)  /* NOTE: The following test is needed, since sizeof(struct tupel) * is somewhat greater than sizeof(struct svalue). */
dc384d2006-03-11Henrik Grubbström (Grubba)  if (from->size > (ptrdiff_t)(LONG_MAX/sizeof(struct replace_many_tupel)))
99e4f02004-10-15Henrik Grubbström (Grubba)  Pike_error("Array too large (size %" PRINTPTRDIFFT "d "
bd5e8b2004-10-16Marcus Agehall  "exceeds %" PRINTSIZET "u).\n",
dc384d2006-03-11Henrik Grubbström (Grubba)  from->size, (size_t)(LONG_MAX/sizeof(struct replace_many_tupel)));
652b672008-05-01Martin Stjernholm #endif
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->v = (struct replace_many_tupel *) xalloc(sizeof(struct replace_many_tupel) * from->size);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(num=e=0;e<from->size;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
24e45c2006-03-11Henrik Grubbström (Grubba)  if (!ITEM(from)[e].u.string->len) { if (ITEM(to)[e].u.string->len) {
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->empty_repl = ITEM(to)[e].u.string;
24e45c2006-03-11Henrik Grubbström (Grubba)  } continue; }
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->v[num].ind=ITEM(from)[e].u.string; ctx->v[num].val=ITEM(to)[e].u.string; ctx->v[num].prefix=-2; /* Uninitialized */ ctx->v[num].is_prefix=0;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  num++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->flags = reference_strings; if (reference_strings) { /* Used for the precompiled compiled case. */ if (ctx->empty_repl) add_ref(ctx->empty_repl); for (e = 0; e < num; e++) { add_ref(ctx->v[e].ind); add_ref(ctx->v[e].val); } }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
dc384d2006-03-11Henrik Grubbström (Grubba)  fsort((char *)ctx->v, num, sizeof(struct replace_many_tupel), (fsortfun)replace_sortfun); MEMSET(ctx->set_start, 0, sizeof(ctx->set_start)); MEMSET(ctx->set_end, 0, sizeof(ctx->set_end)); ctx->other_start = num;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(e=0;e<num;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
24e45c2006-03-11Henrik Grubbström (Grubba)  { p_wchar2 x;
dc384d2006-03-11Henrik Grubbström (Grubba)  if (ctx->v[num-1-e].ind->len) { x=index_shared_string(ctx->v[num-1-e].ind,0);
7489bb2008-06-29Martin Stjernholm  if ((size_t) x < NELEM(ctx->set_start))
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->set_start[x]=num-e-1;
24e45c2006-03-11Henrik Grubbström (Grubba)  else
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->other_start = num-e-1;
24e45c2006-03-11Henrik Grubbström (Grubba)  }
dc384d2006-03-11Henrik Grubbström (Grubba)  if (ctx->v[e].ind->len) { x=index_shared_string(ctx->v[e].ind,0);
7489bb2008-06-29Martin Stjernholm  if ((size_t) x < NELEM(ctx->set_end))
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->set_end[x]=e+1;
24e45c2006-03-11Henrik Grubbström (Grubba)  } } { INT32 prefix = e-1; if (prefix >= 0) { ptrdiff_t tmp =
dc384d2006-03-11Henrik Grubbström (Grubba)  generic_find_binary_prefix(ctx->v[e].ind->str, ctx->v[e].ind->len, ctx->v[e].ind->size_shift, ctx->v[prefix].ind->str, ctx->v[prefix].ind->len, ctx->v[prefix].ind->size_shift);
24e45c2006-03-11Henrik Grubbström (Grubba)  if (!tmp) {
dc384d2006-03-11Henrik Grubbström (Grubba)  /* ctx->v[prefix] is a valid prefix to ctx->v[e]. */
24e45c2006-03-11Henrik Grubbström (Grubba)  } if (tmp == 1) { /* Optimization. */ prefix = -1; } else {
d8fc6f2006-03-10Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG
24e45c2006-03-11Henrik Grubbström (Grubba)  if (tmp < 0) Pike_fatal("Sorting with replace_sortfunc failed.\n");
d8fc6f2006-03-10Henrik Grubbström (Grubba) #endif
18d9352006-03-10Henrik Grubbström (Grubba) 
24e45c2006-03-11Henrik Grubbström (Grubba)  /* Find the first prefix that is shorter than the point at which * the initial strings differed. */ while (prefix >= 0) {
dc384d2006-03-11Henrik Grubbström (Grubba)  if (ctx->v[prefix].ind->len < tmp) break; prefix = ctx->v[prefix].prefix;
24e45c2006-03-11Henrik Grubbström (Grubba)  } } if (prefix >= 0) {
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->v[prefix].is_prefix = 1;
d8fc6f2006-03-10Henrik Grubbström (Grubba)  }
3f268a2006-03-09Henrik Grubbström (Grubba)  }
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->v[e].prefix = prefix;
3f268a2006-03-09Henrik Grubbström (Grubba)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->num = num; }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
dc384d2006-03-11Henrik Grubbström (Grubba) struct pike_string *execute_replace_many(struct replace_many_context *ctx, struct pike_string *str) { struct string_builder ret; ONERROR uwp; init_string_builder(&ret, str->size_shift); SET_ONERROR(uwp, free_string_builder, &ret);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
2a7ae62006-03-10Henrik Grubbström (Grubba)  /* FIXME: We really ought to build a trie! */
d8fc6f2006-03-10Henrik Grubbström (Grubba) 
007b462006-03-11Henrik Grubbström (Grubba)  switch (str->size_shift) { #define CASE(SZ) \ case (SZ): \ { \ PIKE_CONCAT(p_wchar, SZ) *ss = \ PIKE_CONCAT(STR, SZ)(str); \
dc384d2006-03-11Henrik Grubbström (Grubba)  ptrdiff_t e, s, length = str->len; \
007b462006-03-11Henrik Grubbström (Grubba)  for(e = s = 0;length > 0;) \ { \ INT32 a, b; \ p_wchar2 ch; \ \ ch = ss[s]; \ if(OPT_IS_CHAR(ch)) { \
dc384d2006-03-11Henrik Grubbström (Grubba)  b = ctx->set_end[ch]; \
007b462006-03-11Henrik Grubbström (Grubba)  if (!b) \ goto PIKE_CONCAT(next_char, SZ); \
dc384d2006-03-11Henrik Grubbström (Grubba)  a = ctx->set_start[ch]; \
007b462006-03-11Henrik Grubbström (Grubba)  } else { \
dc384d2006-03-11Henrik Grubbström (Grubba)  b = ctx->num; \ a = ctx->other_start; \
007b462006-03-11Henrik Grubbström (Grubba)  } \ if (a >= b) \ goto PIKE_CONCAT(next_char, SZ); \ \ a = find_longest_prefix((char *)(ss + s), \ length, \ SZ, \
dc384d2006-03-11Henrik Grubbström (Grubba)  ctx->v, a, b); \
007b462006-03-11Henrik Grubbström (Grubba)  \ if(a >= 0) \ { \ if (s != e) { \ PIKE_CONCAT(string_builder_binary_strcat, \
dc384d2006-03-11Henrik Grubbström (Grubba)  SZ)(&ret, ss+e, s-e); \
007b462006-03-11Henrik Grubbström (Grubba)  } \
dc384d2006-03-11Henrik Grubbström (Grubba)  ch = ctx->v[a].ind->len; \
007b462006-03-11Henrik Grubbström (Grubba)  s += ch; \ length -= ch; \ e = s; \
dc384d2006-03-11Henrik Grubbström (Grubba)  string_builder_shared_strcat(&ret, \ ctx->v[a].val); \ if (ctx->empty_repl && length) { \
007b462006-03-11Henrik Grubbström (Grubba)  /* Append the replacement for \ * the empty string too. */ \
dc384d2006-03-11Henrik Grubbström (Grubba)  string_builder_shared_strcat(&ret, \ ctx->empty_repl); \
007b462006-03-11Henrik Grubbström (Grubba)  } \ continue; \ } \ \ PIKE_CONCAT(next_char, SZ): \ s++; \ length--; \
dc384d2006-03-11Henrik Grubbström (Grubba)  if (ctx->empty_repl && length) { \
007b462006-03-11Henrik Grubbström (Grubba)  /* We have a replace with the empty string, \ * and we're not on the last character \ * in the source string. \ */ \
dc384d2006-03-11Henrik Grubbström (Grubba)  string_builder_putchar(&ret, ch); \ string_builder_shared_strcat(&ret, \ ctx->empty_repl); \
007b462006-03-11Henrik Grubbström (Grubba)  e = s; \ } \ } \ if (e < s) { \ PIKE_CONCAT(string_builder_binary_strcat, SZ) \
dc384d2006-03-11Henrik Grubbström (Grubba)  (&ret, ss+e, s-e); \
007b462006-03-11Henrik Grubbström (Grubba)  } \ } \ break #define OPT_IS_CHAR(X) 1 CASE(0); #undef OPT_IS_CHAR
7489bb2008-06-29Martin Stjernholm #define OPT_IS_CHAR(X) ((size_t) (X) < NELEM(ctx->set_end))
007b462006-03-11Henrik Grubbström (Grubba)  CASE(1); CASE(2); #undef OPT_IS_CHAR
d8fc6f2006-03-10Henrik Grubbström (Grubba)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
dc384d2006-03-11Henrik Grubbström (Grubba)  UNSET_ONERROR(uwp); return finish_string_builder(&ret); } static struct pike_string *replace_many(struct pike_string *str, struct array *from, struct array *to) { struct replace_many_context ctx; ONERROR uwp; struct pike_string *ret; if(from->size != to->size) Pike_error("Replace must have equal-sized from and to arrays.\n"); if(!from->size) { reference_shared_string(str); return str; } if( (from->type_field & ~BIT_STRING) && (array_fix_type_field(from) & ~BIT_STRING) ) Pike_error("replace: from array not array(string).\n"); if( (to->type_field & ~BIT_STRING) && (array_fix_type_field(to) & ~BIT_STRING) ) Pike_error("replace: to array not array(string).\n"); if (from->size == 1) { /* Just a single string... */ return string_replace(str, from->item[0].u.string, to->item[0].u.string); } compile_replace_many(&ctx, from, to, 0); SET_ONERROR(uwp, free_replace_many_context, &ctx); ret = execute_replace_many(&ctx, str); CALL_AND_UNSET_ONERROR(uwp); return 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)
7f0f342006-03-09Henrik Grubbström (Grubba)  *! @decl string replace(string s, array(string) from, string to)
bd33e72001-02-07Martin Nilsson  *! @decl string replace(string s, mapping(string:string) replacements)
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! @decl array replace(array a, mixed from, mixed to) *! @decl mapping replace(mapping a, mixed from, mixed to) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Generic replace function.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function can do several kinds replacement operations, the *! different syntaxes do different things as follows:
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! If all the arguments are strings, a copy of @[s] with every *! occurrence of @[from] replaced with @[to] will be returned. *! Special case: @[to] will be inserted between every character in *! @[s] if @[from] is the empty string.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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. Instead of the arrays @[from] and @[to]
f79bd82003-04-01Martin Nilsson  *! a mapping equvivalent to @expr{@[mkmapping](@[from], @[to])@} can be
554e222001-05-06Henrik Grubbström (Grubba)  *! used.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! Note that @[replace()] on arrays and mappings is a destructive operation.
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
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 &&
a8cdf92004-04-29Martin Nilsson  Pike_sp[-1].type==T_MAPPING)
f7a4462000-10-31Mirar (Pontus Hagland)  {
200bfd2004-05-14Martin Nilsson  struct mapping *m = Pike_sp[-1].u.mapping; if( (m->data->ind_types & ~BIT_STRING) || (m->data->val_types & ~BIT_STRING) ) { mapping_fix_type_field(Pike_sp[-1].u.mapping); if( (m->data->ind_types & ~BIT_STRING) || (m->data->val_types & ~BIT_STRING) ) { SIMPLE_BAD_ARG_ERROR("replace", 2, "mapping(string:string)"); } }
f7a4462000-10-31Mirar (Pontus Hagland)  stack_dup(); f_indices(1); stack_swap(); f_values(1); args++; } else SIMPLE_TOO_FEW_ARGS_ERROR("replace", 3);
7f0f342006-03-09Henrik Grubbström (Grubba)  } else if (args > 3) { pop_n_elems(args-3); args = 3;
f7a4462000-10-31Mirar (Pontus Hagland)  }
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");
a8cdf92004-04-29Martin Nilsson 
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:
7f0f342006-03-09Henrik Grubbström (Grubba)  if (Pike_sp[2-args].type == T_STRING) { push_int(Pike_sp[1-args].u.array->size); stack_swap(); f_allocate(2); } else if(Pike_sp[2-args].type != T_ARRAY) SIMPLE_BAD_ARG_ERROR("replace", 3, "array|string");
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)  } }
6377672001-06-01Henrik Grubbström (Grubba) node *optimize_replace(node *n) { node **arg0 = my_get_arg(&_CDR(n), 0); struct pike_type *array_zero; struct pike_type *mapping_zero;
5527f72008-01-13Henrik Grubbström (Grubba)  if (!arg0) return NULL;
6377672001-06-01Henrik Grubbström (Grubba)  MAKE_CONSTANT_TYPE(array_zero, tArr(tZero)); MAKE_CONSTANT_TYPE(mapping_zero, tMap(tZero, tZero));
5527f72008-01-13Henrik Grubbström (Grubba)  if ((pike_types_le(array_zero, (*arg0)->type) ||
6377672001-06-01Henrik Grubbström (Grubba)  pike_types_le(mapping_zero, (*arg0)->type))) { /* First argument might be an array or a mapping. * * replace() is destructive on arrays and mappings. */ n->node_info |= OPT_SIDE_EFFECT; n->tree_info |= OPT_SIDE_EFFECT;
fed7de2001-06-28Henrik Grubbström (Grubba)  } else { /* First argument is not an array or mapping, *
229f692004-12-18Henrik Grubbström (Grubba)  * It must thus be a string.
fed7de2001-06-28Henrik Grubbström (Grubba)  */ node **arg1 = my_get_arg(&_CDR(n), 1); node **arg2 = my_get_arg(&_CDR(n), 2);
a842b22006-03-11Henrik Grubbström (Grubba)  struct program *replace_compiler = NULL;
fed7de2001-06-28Henrik Grubbström (Grubba) 
dc384d2006-03-11Henrik Grubbström (Grubba)  if (arg1 && ((pike_types_le((*arg1)->type, array_type_string) && arg2 && (pike_types_le((*arg2)->type, array_type_string) || pike_types_le((*arg2)->type, string_type_string))) || (pike_types_le((*arg1)->type, mapping_type_string)))) { /* Handle the cases: * * replace(string, array, array) * replace(string, array, string) * replace(string, mapping(string:string)) */
a842b22006-03-11Henrik Grubbström (Grubba)  extern struct program *multi_string_replace_program; replace_compiler = multi_string_replace_program; } else if (arg1 && pike_types_le((*arg1)->type, string_type_string) && arg2 && pike_types_le((*arg2)->type, string_type_string)) { extern struct program *single_string_replace_program; replace_compiler = single_string_replace_program; } if (replace_compiler && !is_const(*arg0) && is_const(*arg1) && (!arg2 || is_const(*arg2))) { /* The second and third (if any) arguments are constants. */ struct svalue *save_sp = Pike_sp; JMP_BUF tmp; if (SETJMP(tmp)) {
1ab4ac2008-01-26Martin Stjernholm  struct svalue thrown;
a842b22006-03-11Henrik Grubbström (Grubba)  struct pike_string *s;
1ab4ac2008-01-26Martin Stjernholm  move_svalue (&thrown, &throw_value); mark_free_svalue (&throw_value);
a842b22006-03-11Henrik Grubbström (Grubba)  pop_n_elems(Pike_sp - save_sp); yywarning("Optimizer failure in replace()."); s = format_exception_for_error_msg (&thrown); if (s) { yywarning ("%S", s); free_string (s); } free_svalue(&thrown); } else { INT16 lfun; struct object *replace_obj; node *ret = NULL; INT32 args; args = eval_low(*arg1, 1);
2e45e22008-01-23Henrik Grubbström (Grubba)  if (args != 1) goto failed;
a842b22006-03-11Henrik Grubbström (Grubba)  if (arg2) {
1759c42008-01-21Henrik Grubbström (Grubba)  args += eval_low(*arg2, 1); if (!args) { /* eval_low() returned -1. */
2e45e22008-01-23Henrik Grubbström (Grubba)  goto failed;
1759c42008-01-21Henrik Grubbström (Grubba)  }
a842b22006-03-11Henrik Grubbström (Grubba)  }
cbd1f22001-06-29Henrik Grubbström (Grubba) 
a842b22006-03-11Henrik Grubbström (Grubba)  replace_obj = clone_object(replace_compiler, args);
fed7de2001-06-28Henrik Grubbström (Grubba) 
a842b22006-03-11Henrik Grubbström (Grubba)  push_object(replace_obj); if (replace_obj->prog && ((lfun = FIND_LFUN(replace_obj->prog, LFUN_CALL)) != -1)) { Pike_sp[-1].subtype = lfun; Pike_sp[-1].type = PIKE_T_FUNCTION; ADD_NODE_REF2(*arg0, ret = mkapplynode(mkconstantsvaluenode(Pike_sp-1), *arg0); );
fed7de2001-06-28Henrik Grubbström (Grubba) 
a842b22006-03-11Henrik Grubbström (Grubba)  UNSETJMP(tmp); pop_n_elems(Pike_sp - save_sp);
fed7de2001-06-28Henrik Grubbström (Grubba) 
a842b22006-03-11Henrik Grubbström (Grubba)  free_type(array_zero); free_type(mapping_zero); return ret;
fed7de2001-06-28Henrik Grubbström (Grubba)  } }
2e45e22008-01-23Henrik Grubbström (Grubba)  failed:
a842b22006-03-11Henrik Grubbström (Grubba)  UNSETJMP(tmp); pop_n_elems(Pike_sp - save_sp);
fed7de2001-06-28Henrik Grubbström (Grubba)  }
6377672001-06-01Henrik Grubbström (Grubba)  }
84bf7e2001-06-05Martin Stjernholm  free_type(array_zero); free_type(mapping_zero);
6377672001-06-01Henrik Grubbström (Grubba)  return NULL; }
e290f32006-01-27Henrik Grubbström (Grubba) /*! @decl program compile(string source, CompilationHandler|void handler, @
dc9ca62001-12-12Martin Nilsson  *! int|void major, int|void minor,@ *! program|void target, object|void placeholder)
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Compile a string to a program.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function takes a piece of Pike code as a string and *! compiles it into a clonable program.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! The optional argument @[handler] is used to specify an alternative *! error handler. If it is not specified the current master object will *! be used.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! The optional arguments @[major] and @[minor] are used to tell the *! compiler to attempt to be compatible with Pike @[major].@[minor].
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! Note that @[source] must contain the complete source for a program. *! It is not possible to compile a single expression or statement.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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()].
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @seealso
e290f32006-01-27Henrik Grubbström (Grubba)  *! @[compile_string()], @[compile_file()], @[cpp()], @[master()],
71d3902008-06-01Henrik Grubbström (Grubba)  *! @[CompilationHandler], @[DefaultCompilerEnvironment]
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_compile(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
41c9152008-04-18Henrik Grubbström (Grubba)  apply_low(compilation_environment, CE_COMPILE_FUN_NUM, args);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
ed1cc32001-01-09Henrik Grubbström (Grubba) 
937c462001-02-06Henrik Grubbström (Grubba) /*! @decl array|mapping|multiset set_weak_flag(array|mapping|multiset m, @
84bf7e2001-06-05Martin Stjernholm  *! int state) *! *! Set the value @[m] to use weak or normal references in its *! indices and/or values (whatever is applicable). @[state] is a
cbe8c92003-04-07Martin Nilsson  *! bitfield built by using @expr{|@} between the following flags:
84bf7e2001-06-05Martin Stjernholm  *!
b00d6d2001-07-27Martin Nilsson  *! @int *! @value Pike.WEAK_INDICES
84bf7e2001-06-05Martin Stjernholm  *! Use weak references for indices. Only applicable for *! multisets and mappings.
b00d6d2001-07-27Martin Nilsson  *! @value Pike.WEAK_VALUES
84bf7e2001-06-05Martin Stjernholm  *! Use weak references for values. Only applicable for arrays *! and mappings.
b00d6d2001-07-27Martin Nilsson  *! @value Pike.WEAK
cbe8c92003-04-07Martin Nilsson  *! Shorthand for @expr{Pike.WEAK_INDICES|Pike.WEAK_VALUES@}.
b00d6d2001-07-27Martin Nilsson  *! @endint
84bf7e2001-06-05Martin Stjernholm  *! *! If a flag is absent, the corresponding field will use normal
cbe8c92003-04-07Martin Nilsson  *! references. @[state] can also be @expr{1@} as a compatibility
84bf7e2001-06-05Martin Stjernholm  *! measure; it's treated like @[Pike.WEAK].
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @returns
937c462001-02-06Henrik Grubbström (Grubba)  *! @[m] will be returned.
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
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;
be08a82001-06-06Martin Stjernholm  int flags;
5665ab1999-07-28Henrik Grubbström (Grubba) 
5f06241999-04-11Fredrik Hübinette (Hubbe)  get_all_args("set_weak_flag",args,"%*%i",&s,&ret);
84bf7e2001-06-05Martin Stjernholm  if (ret == 1) ret = PIKE_WEAK_BOTH;
5f06241999-04-11Fredrik Hübinette (Hubbe)  switch(s->type)
3b589f1999-02-04Fredrik Hübinette (Hubbe)  {
5f06241999-04-11Fredrik Hübinette (Hubbe)  case T_ARRAY:
be08a82001-06-06Martin Stjernholm  flags = array_get_flags(s->u.array); SETFLAG(flags,ARRAY_WEAK_FLAG,ret & PIKE_WEAK_VALUES); s->u.array = array_set_flags(s->u.array, flags);
5f06241999-04-11Fredrik Hübinette (Hubbe)  break;
be08a82001-06-06Martin Stjernholm  case T_MAPPING: flags = mapping_get_flags(s->u.mapping);
84bf7e2001-06-05Martin Stjernholm  flags = (flags & ~PIKE_WEAK_BOTH) | (ret & PIKE_WEAK_BOTH);
880be62000-09-04Martin Stjernholm  mapping_set_flags(s->u.mapping, flags);
5f06241999-04-11Fredrik Hübinette (Hubbe)  break;
e99c7a1999-10-29Martin Stjernholm  case T_MULTISET:
5b15bb2001-12-10Martin Stjernholm  flags = multiset_get_flags (s->u.multiset); flags = (flags & ~PIKE_WEAK_BOTH) | (ret & PIKE_WEAK_BOTH); multiset_set_flags (s->u.multiset, flags);
e99c7a1999-10-29Martin Stjernholm  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) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is an object, @expr{0@} (zero) otherwise.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[mappingp()], @[programp()], @[arrayp()], @[stringp()], @[functionp()], *! @[multisetp()], @[floatp()], @[intp()]
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
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) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is a function, @expr{0@} (zero) otherwise.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[mappingp()], @[programp()], @[arrayp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[intp()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_functionp(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
2e04432001-04-09Per Hedbor  int res = 0;
d0d01b1999-03-20Henrik Grubbström (Grubba)  if(args<1) SIMPLE_TOO_FEW_ARGS_ERROR("functionp", 1);
2e04432001-04-09Per Hedbor  if( Pike_sp[-args].type == T_FUNCTION &&
afbf0a2001-04-09Fredrik Hübinette (Hubbe)  (Pike_sp[-args].subtype == FUNCTION_BUILTIN || Pike_sp[-args].u.object->prog))
2e04432001-04-09Per Hedbor  res=1; pop_n_elems(args); push_int(res); } /*! @decl int callablep(mixed arg) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is a callable, @expr{0@} (zero) otherwise.
2e04432001-04-09Per Hedbor  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[mappingp()], @[programp()], @[arrayp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[intp()]
2e04432001-04-09Per Hedbor  */ PMOD_EXPORT void f_callablep(INT32 args) { int res = 0; if(args<1) SIMPLE_TOO_FEW_ARGS_ERROR("callablep", 1); switch( Pike_sp[-args].type )
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
2e04432001-04-09Per Hedbor  case T_FUNCTION: if( Pike_sp[-args].subtype != FUNCTION_BUILTIN && !Pike_sp[-args].u.object->prog) break; res = 1; break; case T_PROGRAM: res = 1; break; case T_OBJECT:
f54c782004-12-22Henrik Grubbström (Grubba)  { struct program *p; if((p = Pike_sp[-args].u.object->prog) && FIND_LFUN(p->inherits[Pike_sp[-args].subtype].prog, LFUN_CALL ) != -1) res = 1; }
e8a76d2003-10-30Martin Nilsson  break; case T_ARRAY:
f54c782004-12-22Henrik Grubbström (Grubba)  /* FIXME: What about the recursive case? */
a8cdf92004-04-29Martin Nilsson  array_fix_type_field(Pike_sp[-args].u.array); if( (Pike_sp[-args].u.array->type_field==BIT_CALLABLE) || !Pike_sp[-args].u.array->type_field) {
e8a76d2003-10-30Martin Nilsson  res = 1;
a8cdf92004-04-29Martin Nilsson  } else if( !(Pike_sp[-args].u.array->type_field & ~(BIT_CALLABLE|BIT_INT)) ) { struct array *a = Pike_sp[-args].u.array; int i; res = 1; for(i=0; i<a->size; i++) if( ITEM(a)[i].type == T_INT && ITEM(a)[i].u.integer ) { res = 0; break; } }
e8a76d2003-10-30Martin Nilsson  break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
2e04432001-04-09Per Hedbor  pop_n_elems(args); push_int(res);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
89b0721998-05-05Fredrik Hübinette (Hubbe) #ifndef HAVE_AND_USE_POLL #undef HAVE_POLL #endif
3714062010-02-18Stephen R. van den Berg static void delaysleep(double delay, unsigned do_abort_on_signal, unsigned do_microsleep)
cb22561995-10-11Fredrik Hübinette (Hubbe) {
3714062010-02-18Stephen R. van den Berg #define POLL_SLEEP_LIMIT 0.02
bebcca2001-11-08Fredrik Hübinette (Hubbe) #ifdef HAVE_GETHRTIME hrtime_t t0,tv; #else struct timeval t0,tv; #endif
3714062010-02-18Stephen R. van den Berg  /* Special case, sleep(0) means 'yield' */ if(delay == 0.0) { check_threads_etc(); return; } if(sizeof(FLOAT_TYPE)<sizeof(double)) delay += FLT_EPSILON*5; /* round up */
bebcca2001-11-08Fredrik Hübinette (Hubbe)  #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) #endif #define FIX_LEFT() \ GET_TIME_ELAPSED; \
3714062010-02-18Stephen R. van den Berg  left = delay - TIME_ELAPSED; \ if (do_microsleep) left-=POLL_SLEEP_LIMIT; if (!do_microsleep || delay>POLL_SLEEP_LIMIT) { for(;;) { double left; /* THREADS_ALLOW may take longer time then POLL_SLEEP_LIMIT */ THREADS_ALLOW(); FIX_LEFT(); if(left>0.0) sysleep(left); THREADS_DISALLOW(); if(do_abort_on_signal) return; FIX_LEFT(); if(left<=0.0) break; check_threads_etc(); } } if (do_microsleep) while (delay>TIME_ELAPSED) GET_TIME_ELAPSED; } /*! @decl void sleep(int|float s, void|int abort_on_signal) *! *! This function makes the program stop for @[s] seconds. *! *! Only signal handlers can interrupt the sleep, and only when *! @[abort_on_signal] is set. If more than one thread is running *! the signal must be sent to the sleeping thread. Other callbacks *! are not called during sleep. *! *! If @[s] is zero then this thread will yield to other threads but *! not sleep otherwise. Note that Pike yields internally at regular *! intervals so it's normally not necessary to do this. *! *! @seealso *! @[signal()], @[delay()] */ PMOD_EXPORT void f_sleep(INT32 args) { double delay=0.0; unsigned do_abort_on_signal;
bebcca2001-11-08Fredrik Hübinette (Hubbe)  switch(Pike_sp[-args].type) { case T_INT: delay=(double)Pike_sp[-args].u.integer; break; case T_FLOAT: delay=(double)Pike_sp[-args].u.float_number; break; }
3714062010-02-18Stephen R. van den Berg  do_abort_on_signal = delay!=0.0 && args > 1 && !UNSAFE_IS_ZERO(Pike_sp + 1-args);
bebcca2001-11-08Fredrik Hübinette (Hubbe)  pop_n_elems(args);
3714062010-02-18Stephen R. van den Berg  delaysleep(delay, do_abort_on_signal, 0);
bebcca2001-11-08Fredrik Hübinette (Hubbe) } #undef FIX_LEFT #undef GET_TIME_ELAPSED #undef TIME_ELAPSED /*! @decl void delay(int|float s) *! *! This function makes the program stop for @[s] seconds. *! *! Only signal handlers can interrupt the sleep. Other callbacks are
768f532002-11-25Martin Nilsson  *! not called during delay. Beware that this function uses busy-waiting
7a5abc2001-11-27Martin Stjernholm  *! to achieve the highest possible accuracy.
bebcca2001-11-08Fredrik Hübinette (Hubbe)  *! *! @seealso *! @[signal()], @[sleep()] */ PMOD_EXPORT void f_delay(INT32 args) {
8380171999-12-06Mirar (Pontus Hagland)  double delay=0.0;
3714062010-02-18Stephen R. van den Berg  unsigned do_abort_on_signal;
0dbb5c2000-02-22Fredrik Hübinette (Hubbe) 
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) 
3714062010-02-18Stephen R. van den Berg  do_abort_on_signal = delay!=0.0 && args > 1 && !UNSAFE_IS_ZERO(Pike_sp + 1-args);
8380171999-12-06Mirar (Pontus Hagland)  pop_n_elems(args);
3714062010-02-18Stephen R. van den Berg  delaysleep(delay, do_abort_on_signal, !do_abort_on_signal && delay<10);
cb22561995-10-11Fredrik Hübinette (Hubbe) }
937c462001-02-06Henrik Grubbström (Grubba) /*! @decl int gc()
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Force garbage collection.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function checks all the memory for cyclic structures such *! as arrays containing themselves and frees them if appropriate.
7a5abc2001-11-27Martin Stjernholm  *! It also frees up destructed objects and things with only weak
5a0d5b2003-01-11Martin Stjernholm  *! references.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.)
5a0d5b2003-01-11Martin Stjernholm  *! *! @returns *! The amount of garbage is returned. This is the number of arrays, *! mappings, multisets, objects and programs that had no nonweak *! external references during the garbage collection. It's normally *! the same as the number of freed things, but there might be some *! difference since destroy() functions are called during freeing, *! which can cause more things to be freed or allocated.
51adb82003-01-12Martin Stjernholm  *! *! @seealso *! @[Pike.gc_parameters], @[Debug.gc_status]
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
624d091996-02-24Fredrik Hübinette (Hubbe) void f_gc(INT32 args) { pop_n_elems(args);
51adb82003-01-12Martin Stjernholm  push_int(do_gc(NULL, 1));
624d091996-02-24Fredrik Hübinette (Hubbe) }
5267b71995-08-09Fredrik Hübinette (Hubbe) #ifdef TYPEP #undef TYPEP #endif
aa73fc1999-10-21Fredrik Hübinette (Hubbe) 
f54c782004-12-22Henrik Grubbström (Grubba) #define TYPEP(ID,NAME,TYPE,TYPE_NAME) \ PMOD_EXPORT void ID(INT32 args) \ { \ int t; \ struct program *p; \ if (args<1) \ SIMPLE_TOO_FEW_ARGS_ERROR(NAME, 1); \ if (Pike_sp[-args].type == T_OBJECT && \ (p = Pike_sp[-args].u.object->prog)) \ { \ int fun = FIND_LFUN(p->inherits[Pike_sp[-args].subtype].prog, \ LFUN__IS_TYPE); \ if (fun != -1) \ { \ int id_level = \ p->inherits[Pike_sp[-args].subtype].identifier_level; \ push_constant_text(TYPE_NAME); \ apply_low(Pike_sp[-args-1].u.object, fun + id_level, 1); \ stack_unlink(args); \ return; \ } \ } \ t = Pike_sp[-args].type == TYPE; \ pop_n_elems(args); \ push_int(t); \ }
b1f4eb1998-01-13Fredrik Hübinette (Hubbe) 
e009522007-11-18Martin Nilsson /*! @decl int undefinedp(mixed arg) *! *! Returns @expr{1@} if @[arg] is undefined, @expr{0@} (zero) otherwise. *! *! @seealso *! @[zero_type], @[destructedp], @[intp] */ PMOD_EXPORT void f_undefinedp(INT32 args) { if( args<1 ) SIMPLE_TOO_FEW_ARGS_ERROR("undefinedp", 1); f_zero_type(args); Pike_sp[-1].u.integer = ( Pike_sp[-1].u.integer == NUMBER_UNDEFINED); } /*! @decl int destructedp(mixed arg) *! *! Returns @expr{1@} if @[arg] is a destructed object, @expr{0@} *! (zero) otherwise. *! *! @seealso *! @[zero_type], @[undefinedp], @[intp] */ PMOD_EXPORT void f_destructedp(INT32 args) { if( args<1 ) SIMPLE_TOO_FEW_ARGS_ERROR("destructedp", 1); f_zero_type(args); Pike_sp[-1].u.integer = ( Pike_sp[-1].u.integer == NUMBER_DESTRUCTED); }
3b0f9f1999-10-22Henrik Grubbström (Grubba) 
9c1a7b2001-01-08Henrik Grubbström (Grubba) /*! @decl int programp(mixed arg) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is a program, @expr{0@} (zero) otherwise.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[mappingp()], @[intp()], @[arrayp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[functionp()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
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) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is an int, @expr{0@} (zero) otherwise.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[mappingp()], @[programp()], @[arrayp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[functionp()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */ /*! @decl int mappingp(mixed arg) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is a mapping, @expr{0@} (zero) otherwise.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[intp()], @[programp()], @[arrayp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[functionp()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */ /*! @decl int arrayp(mixed arg) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is an array, @expr{0@} (zero) otherwise.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[intp()], @[programp()], @[mappingp()], @[stringp()], @[objectp()], *! @[multisetp()], @[floatp()], @[functionp()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */ /*! @decl int multisetp(mixed arg) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is a multiset, @expr{0@} (zero) otherwise.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[intp()], @[programp()], @[arrayp()], @[stringp()], @[objectp()], *! @[mappingp()], @[floatp()], @[functionp()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */ /*! @decl int stringp(mixed arg) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is a string, @expr{0@} (zero) otherwise.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[intp()], @[programp()], @[arrayp()], @[multisetp()], @[objectp()], *! @[mappingp()], @[floatp()], @[functionp()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */ /*! @decl int floatp(mixed arg) *!
cbe8c92003-04-07Martin Nilsson  *! Returns @expr{1@} if @[arg] is a float, @expr{0@} (zero) otherwise.
9c1a7b2001-01-08Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[intp()], @[programp()], @[arrayp()], @[multisetp()], @[objectp()], *! @[mappingp()], @[stringp()], @[functionp()]
9c1a7b2001-01-08Henrik Grubbström (Grubba)  */
d9a93b2001-07-01Fredrik Hübinette (Hubbe) 
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")
ed1cc32001-01-09Henrik Grubbström (Grubba)  /*! @decl array sort(array(mixed) index, array(mixed) ... data) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Sort arrays destructively.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function sorts the array @[index] destructively. That means *! that the array itself is changed and returned, no copy is created.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
0c49782003-04-27Martin Stjernholm  *! The sort order is as follows: *! *! @ul *! @item *! Integers and floats are sorted in ascending order. *! @item *! Strings are sorted primarily on the first characters that are *! different, and secondarily with shorter strings before longer. *! Different characters are sorted in ascending order on the *! character value. Thus the sort order is not locale dependent. *! @item *! Arrays are sorted recursively on the first element. Empty *! arrays are sorted before nonempty ones. *! @item *! Multisets are sorted recursively on the first index. Empty *! multisets are sorted before nonempty ones. *! @item *! Objects are sorted in ascending order according to @[`<()], *! @[`>()] and @[`==()]. *! @item *! Other types aren't reordered. *! @item *! Different types are sorted in this order: Arrays, mappings, *! multisets, objects, functions, programs, strings, types, *! integers and floats. Note however that objects can control *! their ordering wrt other types with @[`<], @[`>] and @[`==], *! so this ordering of types only applies to objects without *! those functions. *! @endul
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @returns
0c49782003-04-27Martin Stjernholm  *! The first argument is returned.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @note
0c49782003-04-27Martin Stjernholm  *! The sort is stable, i.e. elements that are compare-wise equal *! aren't reordered.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @seealso
c306092003-02-16Martin Stjernholm  *! @[Array.sort_array], @[reverse()]
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_sort(INT32 args)
ed70b71996-06-09Fredrik Hübinette (Hubbe) { INT32 e,*order;
0c49782003-04-27Martin Stjernholm  struct array *a;
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
bee4301997-02-24Fredrik Hübinette (Hubbe)  if(args < 1)
d0d01b1999-03-20Henrik Grubbström (Grubba)  SIMPLE_TOO_FEW_ARGS_ERROR("sort", 1);
0c49782003-04-27Martin Stjernholm  if(Pike_sp[-args].type != T_ARRAY) SIMPLE_BAD_ARG_ERROR("sort", 1, "array"); a = Pike_sp[-args].u.array;
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
0c49782003-04-27Martin Stjernholm  for(e=1;e<args;e++)
ed70b71996-06-09Fredrik Hübinette (Hubbe)  {
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) 
0c49782003-04-27Martin Stjernholm  if(Pike_sp[e-args].u.array->size != a->size)
edf4d02000-07-06Fredrik Hübinette (Hubbe)  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) {
0c49782003-04-27Martin Stjernholm  order = stable_sort_array_destructively(a); for(e=1;e<args;e++) order_array(Pike_sp[e-args].u.array,order);
3beb891996-06-21Fredrik Hübinette (Hubbe)  pop_n_elems(args-1);
0c49782003-04-27Martin Stjernholm  free((char *)order); } else { /* If there are only simple types in the array we can use unstable * sorting. */
caa6762003-04-27Martin Stjernholm  array_fix_unfinished_type_field (a);
0c49782003-04-27Martin Stjernholm  if (a->type_field & BIT_COMPLEX) free (stable_sort_array_destructively (a)); else sort_array_destructively (a);
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) *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Select a set of rows from an array.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function is en optimized equivalent to:
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
f79bd82003-04-01Martin Nilsson  *! @code *! map(@[index], lambda(mixed x) { return @[data][x]; }) *! @endcode
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! That is, it indices data on every index in the array index and *! returns an array with the results.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[column()]
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
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;
2523ce2003-04-28Martin Stjernholm  TYPE_FIELD types;
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;
2523ce2003-04-28Martin Stjernholm  types = 0;
8669721999-08-02Fredrik Hübinette (Hubbe)  for(e=0;e<tmp->size;e++) { index_no_free(&sval, val, ITEM(tmp)+e);
2523ce2003-04-28Martin Stjernholm  types |= 1 << sval.type;
8669721999-08-02Fredrik Hübinette (Hubbe)  free_svalue(ITEM(tmp)+e);
2523ce2003-04-28Martin Stjernholm  move_svalue (ITEM(tmp) + e, &sval);
8669721999-08-02Fredrik Hübinette (Hubbe)  }
2523ce2003-04-28Martin Stjernholm  tmp->type_field = types;
8669721999-08-02Fredrik Hübinette (Hubbe)  stack_swap(); pop_stack(); return; }
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
8669721999-08-02Fredrik Hübinette (Hubbe)  push_array(a=allocate_array(tmp->size));
2523ce2003-04-28Martin Stjernholm  types = 0; for(e=0;e<a->size;e++) {
d0d01b1999-03-20Henrik Grubbström (Grubba)  index_no_free(ITEM(a)+e, val, ITEM(tmp)+e);
2523ce2003-04-28Martin Stjernholm  types |= 1 << ITEM(a)[e].type; } a->type_field = types;
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); }
768f532002-11-25Martin Nilsson /*! @decl void verify_internals() *! @belongs Debug
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Perform sanity checks.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! 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.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @note
50d97a2003-02-01Martin Stjernholm  *! This function does a more thorough check if the Pike runtime has *! been compiled with RTL debug.
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
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;
8111162003-09-07Martin Nilsson  ASSERT_SECURITY_ROOT("_verify_internals");
20ee332003-09-08Martin Stjernholm  /* Keep below calls to low_thorough_check_short_svalue, or else we * get O(n!) or so, where n is the number of allocated things. */ d_flag = 49;
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG do_debug(); /* Calls do_gc() since d_flag > 3. */ #else
7458da2003-02-02Martin Stjernholm  do_gc(NULL, 1);
50d97a2003-02-01Martin Stjernholm #endif
ed70b71996-06-09Fredrik Hübinette (Hubbe)  d_flag=tmp; pop_n_elems(args); }
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
768f532002-11-25Martin Nilsson /*! @decl int debug(int(0..) level) *! @belongs Debug
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Set the run-time debug level.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @returns
554e222001-05-06Henrik Grubbström (Grubba)  *! The old debug level will be returned.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! This function is only available if the Pike runtime has been compiled *! with RTL debug.
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
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;
8111162003-09-07Martin Nilsson  ASSERT_SECURITY_ROOT("_debug");
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) }
768f532002-11-25Martin Nilsson /*! @decl int optimizer_debug(int(0..) level) *! @belongs Debug
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Set the optimizer debug level.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @returns
554e222001-05-06Henrik Grubbström (Grubba)  *! The old optimizer debug level will be returned.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! This function is only available if the Pike runtime has been compiled *! with RTL debug.
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f__optimizer_debug(INT32 args)
bcc9181999-11-14Henrik Grubbström (Grubba) { INT_TYPE l;
8111162003-09-07Martin Nilsson  ASSERT_SECURITY_ROOT("_optimizer_debug");
bcc9181999-11-14Henrik Grubbström (Grubba)  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) 
768f532002-11-25Martin Nilsson /*! @decl int assembler_debug(int(0..) level) *! @belongs Debug
3dba602001-01-11Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Set the assembler debug level.
3dba602001-01-11Henrik Grubbström (Grubba)  *! *! @returns
554e222001-05-06Henrik Grubbström (Grubba)  *! The old assembler debug level will be returned.
3dba602001-01-11Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! This function is only available if the Pike runtime has been compiled *! with RTL debug.
3dba602001-01-11Henrik Grubbström (Grubba)  */ PMOD_EXPORT void f__assembler_debug(INT32 args) { INT_TYPE l;
8111162003-09-07Martin Nilsson  ASSERT_SECURITY_ROOT("_assembler_debug");
3dba602001-01-11Henrik Grubbström (Grubba) 
6933442002-05-14Henrik Grubbström (Grubba)  get_all_args("_assembler_debug", args, "%i", &l);
3dba602001-01-11Henrik Grubbström (Grubba)  pop_n_elems(args); push_int(a_flag); a_flag = l; }
786b962009-06-23Henrik Grubbström (Grubba) /*! @decl void _dump_program_tables(program p, int|void indent)
c511aa2006-01-20Henrik Grubbström (Grubba)  *! *! Dumps the internal tables for the program @[p] on stderr.
786b962009-06-23Henrik Grubbström (Grubba)  *! *! @param p *! Program to dump. *! *! @param indent *! Number of spaces to indent the output. *! *! @note *! In Pike 7.8.308 and earlier @[indent] wasn't supported.
c511aa2006-01-20Henrik Grubbström (Grubba)  */ void f__dump_program_tables(INT32 args) { struct program *p;
786b962009-06-23Henrik Grubbström (Grubba)  int indent = 0;
c511aa2006-01-20Henrik Grubbström (Grubba)  ASSERT_SECURITY_ROOT("_dump_program_tables"); /* FIXME: Might want lower. */
786b962009-06-23Henrik Grubbström (Grubba)  get_all_args("_dump_program_tables", args, "%p.%d", &p, &indent);
c511aa2006-01-20Henrik Grubbström (Grubba) 
786b962009-06-23Henrik Grubbström (Grubba)  dump_program_tables(p, indent);
c511aa2006-01-20Henrik Grubbström (Grubba)  pop_n_elems(args); }
3dba602001-01-11Henrik Grubbström (Grubba) 
2f54f71998-04-13Henrik Grubbström (Grubba) #ifdef YYDEBUG
768f532002-11-25Martin Nilsson /*! @decl int compiler_trace(int(0..) level) *! @belongs Debug
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! Set the compiler trace level.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @returns
554e222001-05-06Henrik Grubbström (Grubba)  *! The old compiler trace level will be returned.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @note
554e222001-05-06Henrik Grubbström (Grubba)  *! This function is only available if the Pike runtime has been compiled *! with RTL debug.
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
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;
8111162003-09-07Martin Nilsson  ASSERT_SECURITY_ROOT("_compiler_trace");
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) {
f0e6f12003-12-06Martin Nilsson  push_text("sec");
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_int(tm->tm_sec);
f0e6f12003-12-06Martin Nilsson  push_text("min");
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_int(tm->tm_min);
f0e6f12003-12-06Martin Nilsson  push_text("hour");
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_int(tm->tm_hour);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) 
f0e6f12003-12-06Martin Nilsson  push_text("mday");
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_int(tm->tm_mday);
f0e6f12003-12-06Martin Nilsson  push_text("mon");
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_int(tm->tm_mon);
f0e6f12003-12-06Martin Nilsson  push_text("year");
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_int(tm->tm_year);
f0e6f12003-12-06Martin Nilsson  push_text("wday");
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_int(tm->tm_wday);
f0e6f12003-12-06Martin Nilsson  push_text("yday");
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_int(tm->tm_yday);
f0e6f12003-12-06Martin Nilsson  push_text("isdst");
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_int(tm->tm_isdst);
fe91501998-07-26Peter J. Holzer } #endif
1bf4192006-07-02Martin Stjernholm #if defined (HAVE_GMTIME) || defined (HAVE_GMTIME_R) || defined (HAVE_GMTIME_S)
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl mapping(string:int) gmtime(int timestamp) *!
df0f872003-04-14Martin Stjernholm  *! Convert seconds since 00:00:00 UTC, Jan 1, 1970 into components.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function works like @[localtime()] but the result is *! not adjusted for the local time zone.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[localtime()], @[time()], @[ctime()], @[mktime()]
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_gmtime(INT32 args)
fe91501998-07-26Peter J. Holzer {
1bf4192006-07-02Martin Stjernholm #if defined (HAVE_GMTIME_R) || defined (HAVE_GMTIME_S) struct tm tm_s; #endif
fe91501998-07-26Peter J. Holzer  struct tm *tm;
14f6892008-04-22Martin Stjernholm  LONGEST tt;
fe91501998-07-26Peter J. Holzer  time_t t;
14f6892008-04-22Martin Stjernholm  get_all_args("gmtime", args, "%l", &tt); #if SIZEOF_TIME_T < SIZEOF_LONGEST if (tt > MAX_TIME_T || tt < MIN_TIME_T) SIMPLE_ARG_ERROR ("gmtime", 1, "Timestamp outside valid range."); #endif t = (time_t) tt;
d0d01b1999-03-20Henrik Grubbström (Grubba) 
1bf4192006-07-02Martin Stjernholm #ifdef HAVE_GMTIME_R tm = gmtime_r (&t, &tm_s); #elif defined (HAVE_GMTIME_S)
8e71e52008-06-25Martin Stjernholm  if (!gmtime_s (&tm_s, &t)) tm = &tm_s; else tm = NULL;
1bf4192006-07-02Martin Stjernholm #else
d0d01b1999-03-20Henrik Grubbström (Grubba)  tm = gmtime(&t);
1bf4192006-07-02Martin Stjernholm #endif
f917a32002-10-03Martin Stjernholm  if (!tm) Pike_error ("gmtime() on this system cannot handle "
8e71e52008-06-25Martin Stjernholm  "the timestamp %"PRINTLONGEST"d.\n", (LONGEST) t);
fe91501998-07-26Peter J. Holzer  pop_n_elems(args); encode_struct_tm(tm);
f0e6f12003-12-06Martin Nilsson  push_text("timezone");
fe91501998-07-26Peter J. Holzer  push_int(0); f_aggregate_mapping(20); } #endif #ifdef HAVE_LOCALTIME
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl mapping(string:int) localtime(int timestamp) *!
df0f872003-04-14Martin Stjernholm  *! Convert seconds since 00:00:00 UTC, 1 Jan 1970 into components.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @returns
554e222001-05-06Henrik Grubbström (Grubba)  *! This function returns a mapping with the following components: *! @mapping *! @member int(0..60) "sec" *! Seconds over the minute. *! @member int(0..59) "min" *! Minutes over the hour. *! @member int(0..23) "hour" *! Hour of the day. *! @member int(1..31) "mday" *! Day of the month. *! @member int(0..11) "mon" *! Month of the year. *! @member int(0..) "year" *! Year since 1900. *! @member int(0..6) "wday" *! Day of week (0 = Sunday). *! @member int(0..365) "yday" *! Day of the year. *! @member int(0..1) "isdst" *! Is daylight savings time. *! @member int "timezone"
69a3422004-04-01Henrik Grubbström (Grubba)  *! Offset from UTC, including daylight savings time adjustment.
554e222001-05-06Henrik Grubbström (Grubba)  *! @endmapping
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
f917a32002-10-03Martin Stjernholm  *! An error is thrown if the localtime(2) call failed on the system.
b5b1b22002-10-03Martin Stjernholm  *! It's platform dependent what time ranges that function can handle, *! e.g. Windows doesn't handle a negative @[timestamp]. *!
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! @note
69a3422004-04-01Henrik Grubbström (Grubba)  *! Prior to Pike 7.5 the field @expr{"timezone"@} was sometimes not *! present, and was sometimes not adjusted for daylight savings time.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[Calendar], @[gmtime()], @[time()], @[ctime()], @[mktime()]
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_localtime(INT32 args)
fe91501998-07-26Peter J. Holzer { struct tm *tm;
14f6892008-04-22Martin Stjernholm  LONGEST tt;
fe91501998-07-26Peter J. Holzer  time_t t;
14f6892008-04-22Martin Stjernholm  get_all_args("localtime", args, "%l", &tt); #if SIZEOF_TIME_T < SIZEOF_LONGEST if (tt > MAX_TIME_T || tt < MIN_TIME_T)
7712092008-04-23Martin Stjernholm  SIMPLE_ARG_ERROR ("localtime", 1, "Timestamp outside valid range.");
14f6892008-04-22Martin Stjernholm #endif t = (time_t) tt;
d0d01b1999-03-20Henrik Grubbström (Grubba)  tm = localtime(&t);
f917a32002-10-03Martin Stjernholm  if (!tm) Pike_error ("localtime() on this system cannot handle " "the timestamp %ld.\n", (long) t);
fe91501998-07-26Peter J. Holzer  pop_n_elems(args); encode_struct_tm(tm);
3beb891996-06-21Fredrik Hübinette (Hubbe) 
f0e6f12003-12-06Martin Nilsson  push_text("timezone");
69a3422004-04-01Henrik Grubbström (Grubba) #ifdef STRUCT_TM_HAS_GMTOFF
47ba812002-03-21Henrik Grubbström (Grubba)  push_int(-tm->tm_gmtoff);
69a3422004-04-01Henrik Grubbström (Grubba) #elif defined(STRUCT_TM_HAS___TM_GMTOFF)
47ba812002-03-21Henrik Grubbström (Grubba)  push_int(-tm->__tm_gmtoff);
69a3422004-04-01Henrik Grubbström (Grubba) #elif defined(HAVE_EXTERNAL_TIMEZONE) /* Assume dst is one hour. */ push_int(timezone - 3600*tm->tm_isdst);
3beb891996-06-21Fredrik Hübinette (Hubbe) #else
69a3422004-04-01Henrik Grubbström (Grubba)  /* Assume dst is one hour. */ push_int(-3600*tm->tm_isdst);
47ba812002-03-21Henrik Grubbström (Grubba) #endif
69a3422004-04-01Henrik Grubbström (Grubba)  f_aggregate_mapping(20);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
3beb891996-06-21Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) 
86d9aa2004-12-13Martin Stjernholm #if defined (HAVE_GMTIME) || defined (HAVE_LOCALTIME)
7785682007-03-29Martin Stjernholm  #define isleap(y) ((((y) % 4) == 0 && ((y) % 100) != 0) || ((y) % 400) == 0) static const int mon_lengths[2][12] = { {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}, {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31} }; static void normalize_date (struct tm *t) /* Normalizes t->tm_mday and t->tm_mon. */ { int q, year, mon, mday, leap; q = t->tm_mon / 12; if (t->tm_mon < 0) q--; t->tm_mon -= q * 12; t->tm_year += q; year = t->tm_year + 1900; leap = isleap (year); mon = t->tm_mon; mday = t->tm_mday; if (mday > 0) { int mon_len = mon_lengths[leap][mon]; if (mday <= mon_len) return; do { mday -= mon_len; if (++mon == 12) mon = 0, year++, leap = isleap (year); } while (mday > (mon_len = mon_lengths[leap][mon])); } else do { if (mon == 0) mon = 11, year--, leap = isleap (year); else mon--; mday += mon_lengths[leap][mon]; } while (mday < 1); t->tm_year = year - 1900; t->tm_mon = mon; t->tm_mday = mday; } #define CHECKED_DIFF_MULT(RES, A, B, MULT, OVERFLOW) do { \ RES = (A - B) * (MULT); \ if ((A > B) != (RES > 0)) {OVERFLOW;} \ } while (0) #define CHECKED_ADD(ACC, DIFF, OVERFLOW) do { \ time_t res_ = ACC + DIFF; \ if ((ACC > 0) == (DIFF > 0) && (ACC > 0) != (res_ > 0)) \ {OVERFLOW;} \ else \ ACC = res_; \ } while (0)
a7c4d92004-01-30Henrik Grubbström (Grubba) /* Returns the approximate difference in seconds between the * two struct tm's. */ static time_t my_tm_diff(const struct tm *t1, const struct tm *t2) {
7785682007-03-29Martin Stjernholm  time_t base, diff;
aac1c42004-12-22Henrik Grubbström (Grubba)  /* Win32 localtime() returns NULL for all dates before Jan 01, 1970. */ if (!t2) return -1;
7785682007-03-29Martin Stjernholm  CHECKED_DIFF_MULT (base, t1->tm_year, t2->tm_year, 60*60*24*31*12, return base < 0 ? MAX_TIME_T : MIN_TIME_T);
86d9aa2004-12-13Martin Stjernholm 
7785682007-03-29Martin Stjernholm  /* Overflow detection not necessary on these fields since we can * assume they're all in the valid ranges here. */ diff = (t1->tm_mon - t2->tm_mon) * (60*60*24*31) + (t1->tm_mday - t2->tm_mday) * (60*60*24) + (t1->tm_hour - t2->tm_hour) * (60*60) +
a7c4d92004-01-30Henrik Grubbström (Grubba)  (t1->tm_min - t2->tm_min) * 60 + (t1->tm_sec - t2->tm_sec);
86d9aa2004-12-13Martin Stjernholm 
7785682007-03-29Martin Stjernholm  CHECKED_ADD (base, diff, return diff < 0 ? MIN_TIME_T : MAX_TIME_T);
0083c12004-02-02Henrik Grubbström (Grubba)  return base;
a7c4d92004-01-30Henrik Grubbström (Grubba) }
86d9aa2004-12-13Martin Stjernholm typedef struct tm *time_fn (const time_t *);
c3df662004-12-14Martin Stjernholm /* Inverse operation of gmtime or localtime. Unlike mktime(3), this * doesn't fill in a normalized time in target_tm.
a7c4d92004-01-30Henrik Grubbström (Grubba)  */
86d9aa2004-12-13Martin Stjernholm static int my_time_inverse (struct tm *target_tm, time_t *result, time_fn timefn)
a7c4d92004-01-30Henrik Grubbström (Grubba) {
7785682007-03-29Martin Stjernholm  struct tm norm_tm = *target_tm;
a7c4d92004-01-30Henrik Grubbström (Grubba)  time_t current_ts = 0;
7785682007-03-29Martin Stjernholm  time_t displacement;
86d9aa2004-12-13Martin Stjernholm  time_t diff_ts, old_diff_ts = 0; int loop_cnt, tried_dst_displacement = 0;
a7c4d92004-01-30Henrik Grubbström (Grubba) 
7785682007-03-29Martin Stjernholm #ifdef DEBUG_MY_TIME_INVERSE fprintf (stderr, "target: y %d m %d d %d h %d m %d isdst %d\n", target_tm->tm_year, target_tm->tm_mon, target_tm->tm_mday, target_tm->tm_hour, target_tm->tm_min, target_tm->tm_isdst); #endif /* An hour, minute or second value outside the valid range is * treated as a displacement rather than an absolute time spec. We * therefore zero them in the target time spec and add the * displacement seconds back to the time_t afterwards. This way we * don't need to worry about them in the date normalization. */ /* It's quicker to always move the seconds to the displacement. It * works just as well and we don't need to consider leap seconds. */ displacement = norm_tm.tm_sec; norm_tm.tm_sec = 0; /* Bug: The following conversions to seconds ought to compensate for * leap seconds. That should only happen if timefn takes leap * seconds into account however, which it might not do. */ if (norm_tm.tm_min < 0 || norm_tm.tm_min >= 60) { time_t d; CHECKED_DIFF_MULT (d, norm_tm.tm_min, 0, 60, return 0); CHECKED_ADD (displacement, d, return 0); norm_tm.tm_min = 0; } if (norm_tm.tm_hour < 0 || norm_tm.tm_hour >= 60) { time_t d; CHECKED_DIFF_MULT (d, norm_tm.tm_hour, 0, 60*60, return 0); CHECKED_ADD (displacement, d, return 0); norm_tm.tm_hour = 0; } /* Normalize the date. This is necessary since the simplistic diff * calculation in my_tm_diff doesn't work on invalid dates like * November 100th or March -10th. (Can't use the displacement * variable for an invalid tm_mday since the number of seconds per * day isn't constant.) */ normalize_date (&norm_tm); #ifdef DEBUG_MY_TIME_INVERSE fprintf (stderr, "normalized: y %d m %d d %d h %d m %d isdst %d\n" "displacement: %ld\n", norm_tm.tm_year, norm_tm.tm_mon, norm_tm.tm_mday, norm_tm.tm_hour, norm_tm.tm_min, norm_tm.tm_isdst, (long) displacement); #endif
a7c4d92004-01-30Henrik Grubbström (Grubba)  /* This loop seems stable, and usually converges in two passes. * The loop counter is for paranoia reasons. */
86d9aa2004-12-13Martin Stjernholm  for (loop_cnt = 0; loop_cnt < 20; loop_cnt++, old_diff_ts = diff_ts) {
7785682007-03-29Martin Stjernholm  struct tm *current_tm = timefn(&current_ts); #ifdef DEBUG_MY_TIME_INVERSE fprintf (stderr, "curr: y %d m %d d %d h %d m %d isdst %d\n", current_tm->tm_year, current_tm->tm_mon, current_tm->tm_mday, current_tm->tm_hour, current_tm->tm_min, current_tm->tm_isdst); #endif diff_ts = my_tm_diff (&norm_tm, current_tm); #ifdef DEBUG_MY_TIME_INVERSE fprintf (stderr, "diff: %ld\n", (long) diff_ts); #endif
86d9aa2004-12-13Martin Stjernholm 
aac1c42004-12-22Henrik Grubbström (Grubba)  if (!current_tm) { #ifdef DEBUG_MY_TIME_INVERSE fprintf (stderr, "outside range for timefn().\n"); #endif return 0; }
86d9aa2004-12-13Martin Stjernholm  if (!diff_ts) {
7785682007-03-29Martin Stjernholm  /* Got a satisfactory time, but if norm_tm has an opinion on
86d9aa2004-12-13Martin Stjernholm  * DST we should check if we can return an alternative in the * same DST zone, to cope with the overlapping DST adjustment at * fall. */
7785682007-03-29Martin Stjernholm  if (norm_tm.tm_isdst >= 0 && norm_tm.tm_isdst != current_tm->tm_isdst &&
86d9aa2004-12-13Martin Stjernholm  !tried_dst_displacement) { /* Offset the time a day and iterate some more (only once * more, really), so that we approach the target time from the * right direction. */
7785682007-03-29Martin Stjernholm  if (norm_tm.tm_isdst)
86d9aa2004-12-13Martin Stjernholm  current_ts -= 24 * 3600; else current_ts += 24 * 3600; tried_dst_displacement = 1; #ifdef DEBUG_MY_TIME_INVERSE fprintf (stderr, "dst displacement\n"); #endif continue; } break;
a7c4d92004-01-30Henrik Grubbström (Grubba)  }
86d9aa2004-12-13Martin Stjernholm  if (diff_ts == -old_diff_ts) {
7785682007-03-29Martin Stjernholm  /* We're oscillating. Shouldn't happen since norm_tm ought to be * valid. */
86d9aa2004-12-13Martin Stjernholm #ifdef DEBUG_MY_TIME_INVERSE
7785682007-03-29Martin Stjernholm  fprintf (stderr, "oscillation detected: %ld <-> %ld\n", (long) old_diff_ts, (long) diff_ts);
86d9aa2004-12-13Martin Stjernholm #endif
7785682007-03-29Martin Stjernholm  return 0;
86d9aa2004-12-13Martin Stjernholm  }
7785682007-03-29Martin Stjernholm  /* It's ok to not add the full diff here since we're looping. Do * this since the diff calculation can overshoot the target * time. */ CHECKED_ADD (current_ts, diff_ts, { if (diff_ts > 0 && current_ts < MAX_TIME_T) current_ts = MAX_TIME_T; else if (diff_ts < 0 && current_ts > MIN_TIME_T) current_ts = MIN_TIME_T; else return 0; });
a7c4d92004-01-30Henrik Grubbström (Grubba)  }
86d9aa2004-12-13Martin Stjernholm 
7785682007-03-29Martin Stjernholm  CHECKED_ADD (current_ts, displacement, return 0);
86d9aa2004-12-13Martin Stjernholm  *result = current_ts; return 1;
a7c4d92004-01-30Henrik Grubbström (Grubba) }
86d9aa2004-12-13Martin Stjernholm #endif /* HAVE_GMTIME || HAVE_LOCALTIME */
a7c4d92004-01-30Henrik Grubbström (Grubba) 
86d9aa2004-12-13Martin Stjernholm #if defined (HAVE_MKTIME) || defined (HAVE_LOCALTIME)
ed1cc32001-01-09Henrik Grubbström (Grubba) /*! @decl int mktime(mapping(string:int) tm)
3254e12001-02-06Henrik Grubbström (Grubba)  *! @decl int mktime(int sec, int min, int hour, int mday, int mon, int year, @
f3f0e82003-04-27Henrik Grubbström (Grubba)  *! int|void isdst, int|void tz)
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
554e222001-05-06Henrik Grubbström (Grubba)  *! This function converts information about date and time into an integer
df0f872003-04-14Martin Stjernholm  *! which contains the number of seconds since 00:00:00 UTC, Jan 1, 1970.
554e222001-05-06Henrik Grubbström (Grubba)  *! *! You can either call this function with a mapping containing the *! following elements: *! @mapping *! @member int(0..60) "sec" *! Seconds over the minute. *! @member int(0..59) "min" *! Minutes over the hour. *! @member int(0..23) "hour" *! Hour of the day. *! @member int(1..31) "mday" *! Day of the month. *! @member int(0..11) "mon" *! Month of the year. *! @member int(0..) "year" *! Year since 1900. *! @member int(0..1) "isdst" *! Is daylight savings time.
06a3ac2002-05-12Martin Nilsson  *! @member int "timezone"
7792712002-03-21Henrik Grubbström (Grubba)  *! The timezone offset from UTC in seconds. If left out, the time *! will be calculated in the local timezone.
554e222001-05-06Henrik Grubbström (Grubba)  *! @endmapping *! *! Or you can just send them all on one line as the second syntax suggests.
ed1cc32001-01-09Henrik Grubbström (Grubba)  *!
081eea2002-09-09Henrik Grubbström (Grubba)  *! @note
aac1c42004-12-22Henrik Grubbström (Grubba)  *! On some operating systems (notably AIX and Win32), dates before *! 00:00:00 UTC, Jan 1, 1970 are not supported.
081eea2002-09-09Henrik Grubbström (Grubba)  *! *! On most systems, the supported range of dates are Dec 13, 1901 *! 20:45:52 UTC through Jan 19, 2038 03:14:07 UTC (inclusive). *!
ed1cc32001-01-09Henrik Grubbström (Grubba)  *! @seealso
554e222001-05-06Henrik Grubbström (Grubba)  *! @[time()], @[ctime()], @[localtime()], @[gmtime()]
ed1cc32001-01-09Henrik Grubbström (Grubba)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void f_mktime (INT32 args)
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) {
1f88bf2001-09-24Henrik Grubbström (Grubba)  INT_TYPE sec, min, hour, mday, mon, year;
2adf002004-02-29Martin Stjernholm  INT_TYPE isdst = -1, tz;
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  struct tm date;
86d9aa2004-12-13Martin Stjernholm  time_t retval;
1f88bf2001-09-24Henrik Grubbström (Grubba) 
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  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; }
2adf002004-02-29Martin Stjernholm  get_all_args("mktime",args, "%i%i%i%i%i%i.%i%i", &sec, &min, &hour, &mday, &mon, &year, &isdst, &tz);
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;
2adf002004-02-29Martin Stjernholm  date.tm_isdst=isdst;
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) 
ca16832004-01-30Henrik Grubbström (Grubba)  /* date.tm_zone = NULL; */
a7c4d92004-01-30Henrik Grubbström (Grubba)  #ifdef HAVE_GMTIME
86d9aa2004-12-13Martin Stjernholm  if((args > 7) && (Pike_sp[7-args].subtype == NUMBER_NUMBER))
a7c4d92004-01-30Henrik Grubbström (Grubba)  {
86d9aa2004-12-13Martin Stjernholm  /* UTC-relative time. Use gmtime. */ if (!my_time_inverse (&date, &retval, gmtime)) PIKE_ERROR("mktime", "Time conversion failed.\n", Pike_sp, args);
2adf002004-02-29Martin Stjernholm  retval += tz;
86d9aa2004-12-13Martin Stjernholm  } else
a7c4d92004-01-30Henrik Grubbström (Grubba) #endif /* HAVE_GMTIME */
86d9aa2004-12-13Martin Stjernholm  {
c3df662004-12-14Martin Stjernholm #ifndef HAVE_GMTIME
7792712002-03-21Henrik Grubbström (Grubba) #ifdef STRUCT_TM_HAS_GMTOFF
a7c4d92004-01-30Henrik Grubbström (Grubba)  /* BSD-style */ date.tm_gmtoff = 0;
7792712002-03-21Henrik Grubbström (Grubba) #else #ifdef STRUCT_TM_HAS___TM_GMTOFF
c3df662004-12-14Martin Stjernholm  /* (Old) Linux-style */
a7c4d92004-01-30Henrik Grubbström (Grubba)  date.__tm_gmtoff = 0;
419d492002-09-07Henrik Grubbström (Grubba) #else
86d9aa2004-12-13Martin Stjernholm  if((args > 7) && (Pike_sp[7-args].subtype == NUMBER_NUMBER))
a7c4d92004-01-30Henrik Grubbström (Grubba)  { /* Pre-adjust for the timezone. * * Note that pre-adjustment must be done on AIX for dates
86d9aa2004-12-13Martin Stjernholm  * near Jan 1, 1970, since AIX mktime(3) doesn't support
a7c4d92004-01-30Henrik Grubbström (Grubba)  * negative time. */
2adf002004-02-29Martin Stjernholm  date.tm_sec += tz
419d492002-09-07Henrik Grubbström (Grubba) #ifdef HAVE_EXTERNAL_TIMEZONE
a7c4d92004-01-30Henrik Grubbström (Grubba)  - timezone
419d492002-09-07Henrik Grubbström (Grubba) #endif /* HAVE_EXTERNAL_TIMEZONE */
a7c4d92004-01-30Henrik Grubbström (Grubba)  ; }
7792712002-03-21Henrik Grubbström (Grubba) #endif /* STRUCT_TM_HAS___TM_GMTOFF */ #endif /* STRUCT_TM_HAS_GMTOFF */
c3df662004-12-14Martin Stjernholm #endif /* !HAVE_GMTIME */
7792712002-03-21Henrik Grubbström (Grubba) 
c3df662004-12-14Martin Stjernholm #ifdef HAVE_MKTIME
a7c4d92004-01-30Henrik Grubbström (Grubba)  retval = mktime(&date);
c3df662004-12-14Martin Stjernholm  if (retval == -1) #endif {
86d9aa2004-12-13Martin Stjernholm #ifdef HAVE_LOCALTIME
c3df662004-12-14Martin Stjernholm  /* mktime might fail on dates before 1970 (e.g. GNU libc 2.3.2),
aac1c42004-12-22Henrik Grubbström (Grubba)  * so try our own inverse function with localtime. * * Note that localtime on Win32 will also fail for dates before 1970. */
c3df662004-12-14Martin Stjernholm  if (!my_time_inverse (&date, &retval, localtime))
86d9aa2004-12-13Martin Stjernholm #endif
c3df662004-12-14Martin Stjernholm  PIKE_ERROR("mktime", "Time conversion unsuccessful.\n", Pike_sp, args);
a7c4d92004-01-30Henrik Grubbström (Grubba)  }
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) 
c3df662004-12-14Martin Stjernholm #if !defined (HAVE_GMTIME) && (defined(STRUCT_TM_HAS_GMTOFF) || defined(STRUCT_TM_HAS___TM_GMTOFF)) if((args > 7) && (Pike_sp[7-args].subtype == NUMBER_NUMBER))
86d9aa2004-12-13Martin Stjernholm  {
c3df662004-12-14Martin Stjernholm  /* Post-adjust for the timezone. * * Note that tm_gmtoff has the opposite sign of timezone. * * Note also that it must be post-adjusted, since the gmtoff * field is set by mktime(3). */ #ifdef STRUCT_TM_HAS_GMTOFF retval += tz + date.tm_gmtoff; #else retval += tz + date.__tm_gmtoff; #endif /* STRUCT_TM_HAS_GMTOFF */ } #endif /* !HAVE_GMTIME && (STRUCT_TM_HAS_GMTOFF || STRUCT_TM_HAS___TM_GMTOFF) */ #if 0 /* Disabled since the adjustment done here with a hardcoded one * hour is bogus in many time zones. mktime(3) in GNU libc is * documented to normalize the date spec, which means that e.g. * asking for DST time in a non-DST zone will override tm_isdst. * /mast */ if ((isdst != -1) && (isdst != date.tm_isdst)) { /* Some stupid libc's (Hi Linux!) don't accept that we've set isdst... */ retval += 3600 * (isdst - date.tm_isdst);
a7c4d92004-01-30Henrik Grubbström (Grubba)  }
c3df662004-12-14Martin Stjernholm #endif /* 0 */