e576bb2002-10-11Martin Nilsson /* -*- c -*- || 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.
b6b1162018-12-18Henrik Grubbström (Grubba) || $Id$
e576bb2002-10-11Martin Nilsson */
c3da7f2000-07-04Martin Stjernholm 
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) #include "global.h" #include "interpret.h" #include "svalue.h" #include "opcodes.h" #include "pike_macros.h" #include "object.h" #include "program.h" #include "array.h"
bb8a782000-12-01Fredrik Hübinette (Hubbe) #include "pike_error.h"
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) #include "constants.h" #include "mapping.h" #include "stralloc.h" #include "multiset.h" #include "pike_types.h" #include "pike_memory.h" #include "threads.h" #include <math.h> #include <ctype.h> #include "module_support.h" #include "cyclic.h" #include "bignum.h"
098c802000-05-24Fredrik Hübinette (Hubbe) #include "main.h"
b8c5b22000-05-25Fredrik Hübinette (Hubbe) #include "operators.h"
9da7f42001-06-05Martin Stjernholm #include "builtin_functions.h"
fed7de2001-06-28Henrik Grubbström (Grubba) #include "fsort.h"
812f9a2002-04-06Henrik Grubbström (Grubba) #include "port.h"
51adb82003-01-12Martin Stjernholm #include "gc.h"
73b08f2003-01-31Martin Stjernholm #include <assert.h>
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) 
2d8e642002-11-25Martin Nilsson /*! @decl array(array(int|string)) describe_program(program p) *! @belongs Debug
7d1b3b2001-12-21Henrik Grubbström (Grubba)  *! *! Debug function for showing the symbol table of a program. */ PIKEFUN array(array(int|string)) _describe_program(mixed x) efun; { struct program *p; struct array *res; int i;
d4ecd72003-01-05Martin Nilsson  if (!(p = program_from_svalue(Pike_sp - args))) SIMPLE_BAD_ARG_ERROR("_describe_program", 1, "program");
7d1b3b2001-12-21Henrik Grubbström (Grubba)  for (i=0; i < (int)p->num_identifier_references;i++) { struct reference *ref = p->identifier_references + i; struct identifier *id = ID_FROM_PTR(p, ref);
cab69e2002-04-24Henrik Grubbström (Grubba)  struct inherit *inh = INHERIT_FROM_PTR(p, ref);
7d1b3b2001-12-21Henrik Grubbström (Grubba)  push_int(ref->id_flags); ref_push_string(id->name);
cab69e2002-04-24Henrik Grubbström (Grubba)  push_int(id->identifier_flags); if (id->identifier_flags & IDENTIFIER_C_FUNCTION) { push_int(-2); } else { push_int(id->func.offset); } push_int(ref->inherit_offset); push_int(inh->inherit_level); f_aggregate(6);
7d1b3b2001-12-21Henrik Grubbström (Grubba)  } f_aggregate(p->num_identifier_references);
cdf18a2003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
cbaa3a2002-05-24Henrik Grubbström (Grubba)  res = Pike_sp[-1].u.array; Pike_sp--;
7d1b3b2001-12-21Henrik Grubbström (Grubba)  pop_n_elems(args); push_array(res); }
d9a93b2001-07-01Fredrik Hübinette (Hubbe) /*! @decl string basetype(mixed x) *! *! Same as sprintf("%t",x); *! *! @seealso *! @[sprintf()] */ PIKEFUN string basetype(mixed x) efun; optflags OPT_TRY_OPTIMIZE; { int t=x->type; if(x->type == T_OBJECT && x->u.object->prog) { ptrdiff_t fun=FIND_LFUN(x->u.object->prog, LFUN__SPRINTF); if(fun != -1) { push_int('t'); f_aggregate_mapping(0); apply_low(x->u.object, fun, 2); if(Pike_sp[-1].type == T_STRING) { stack_swap(); pop_stack(); return;
9f516a2001-12-16Martin Stjernholm  } else if (UNSAFE_IS_ZERO(Pike_sp-1)) {
63a7302001-07-02Henrik Grubbström (Grubba)  pop_n_elems(2);
9db2bf2001-07-02Henrik Grubbström (Grubba)  push_constant_text("object"); return; } else { Pike_error("Non-string returned from _sprintf()\n");
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  } } } pop_stack(); switch(t) { case T_ARRAY: push_constant_text("array"); break; case T_FLOAT: push_constant_text("float"); break; case T_FUNCTION: push_constant_text("function"); break; case T_INT: push_constant_text("int"); break; case T_MAPPING: push_constant_text("mapping"); break; case T_MULTISET: push_constant_text("multiset"); break; case T_OBJECT: push_constant_text("object"); break; case T_PROGRAM: push_constant_text("program"); break; case T_STRING: push_constant_text("string"); break; case T_TYPE: push_constant_text("type"); break; case T_ZERO: push_constant_text("zero"); break; case T_VOID: push_constant_text("void"); break;
a903032003-02-16Martin Stjernholm  /* The following are internal and shouldn't be applicable in normal use. */ case T_SVALUE_PTR: push_constant_text("svalue_ptr"); break; case T_OBJ_INDEX: push_constant_text("obj_index"); break;
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  case T_MAPPING_DATA: push_constant_text("mapping_data"); break;
a903032003-02-16Martin Stjernholm  case T_PIKE_FRAME: push_constant_text("pike_frame"); break; case T_MULTISET_DATA: push_constant_text("multiset_data"); break;
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  default: push_constant_text("unknown"); break; } } /*! @decl string int2char(int x)
ba24802002-04-07Martin Nilsson  *! @appears String.int2char
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  *! *! Same as sprintf("%c",x); *! *! @seealso *! @[sprintf()] */ PIKEFUN string int2char(int|object x) efun; optflags OPT_TRY_OPTIMIZE; { int c; if(x->type == T_OBJECT && x->u.object->prog) { ptrdiff_t fun=FIND_LFUN(x->u.object->prog, LFUN__SPRINTF); if(fun != -1) { push_int('c'); f_aggregate_mapping(0); apply_low(x->u.object, fun, 2); if(Pike_sp[-1].type == T_STRING) { stack_swap(); pop_stack(); return; }
8f5b5b2001-07-02Henrik Grubbström (Grubba)  Pike_error("Non-string returned from _sprintf()\n");
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  } } if(x->type != T_INT)
d4ecd72003-01-05Martin Nilsson  SIMPLE_BAD_ARG_ERROR("int2char", 1, "int");
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  c=x->u.integer; if(c>=0 && c<256) { struct pike_string *s; s=begin_shared_string(1); s->str[0]=c; RETURN end_shared_string(s); }else{ struct string_builder tmp; init_string_builder(&tmp,0); string_builder_putchar(&tmp, c); RETURN finish_string_builder(&tmp); } }
7b45292001-08-15Fredrik Hübinette (Hubbe) /*! @decl string int2hex(int x)
ba24802002-04-07Martin Nilsson  *! @appears String.int2hex
7b45292001-08-15Fredrik Hübinette (Hubbe)  *! *! Same as sprintf("%x",x); *! *! @seealso *! @[sprintf()] */ PIKEFUN string int2hex(int|object x) efun; optflags OPT_TRY_OPTIMIZE; { INT_TYPE c;
a973872003-01-26Mirar (Pontus Hagland)  unsigned INT_TYPE n;
7b45292001-08-15Fredrik Hübinette (Hubbe)  int len; struct pike_string *s; if(x->type == T_OBJECT && x->u.object->prog) { ptrdiff_t fun=FIND_LFUN(x->u.object->prog, LFUN__SPRINTF); if(fun != -1) { push_int('x'); f_aggregate_mapping(0); apply_low(x->u.object, fun, 2); if(Pike_sp[-1].type == T_STRING) { stack_swap(); pop_stack(); return; } Pike_error("Non-string returned from _sprintf()\n"); } } if(x->type != T_INT)
d4ecd72003-01-05Martin Nilsson  SIMPLE_BAD_ARG_ERROR("int2hex", 1, "int");
7b45292001-08-15Fredrik Hübinette (Hubbe)  c=x->u.integer; len=1; if(c<0) { len++;
9c3a7c2003-01-26Mirar (Pontus Hagland)  n=(-c)&((unsigned INT_TYPE)(-1));
7b45292001-08-15Fredrik Hübinette (Hubbe)  }else{ n=c; }
301e982002-01-18Martin Nilsson  while(n>65535) { n>>=16; len+=4; } while(n>15) { n>>=4; len++; }
7b45292001-08-15Fredrik Hübinette (Hubbe)  s=begin_shared_string(len); c=x->u.integer; if(!c) { s->str[0]='0'; }else{ if(c<0) { s->str[0]='-';
9c3a7c2003-01-26Mirar (Pontus Hagland)  n=(-c)&((unsigned INT_TYPE)(-1));
7b45292001-08-15Fredrik Hübinette (Hubbe)  }else{ n=c; }
301e982002-01-18Martin Nilsson  while(len && n)
7b45292001-08-15Fredrik Hübinette (Hubbe)  { s->str[--len]="0123456789abcdef"[n&0xf]; n>>=4; } } RETURN end_shared_string(s); }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl array column(array data, mixed index) *! *! Extract a column from a two-dimensional array. *! *! This function is exactly equivalent to:
f79bd82003-04-01Martin Nilsson  *! @code *! map(@[data], lambda(mixed x,mixed y) { return x[y]; }, @[index]) *! @endcode
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Except of course it is a lot shorter and faster. *! That is, it indices every index in the array data on the value of *! the argument index and returns an array with the results. *! *! @seealso *! @[rows()] */
b0f8352001-01-07Henrik Grubbström (Grubba) PIKEFUN array column(array data, mixed index)
3a5b1d2000-05-24Fredrik Hübinette (Hubbe)  efun; optflags OPT_TRY_OPTIMIZE; {
fb567a2003-04-27Martin Stjernholm  RETURN array_column (data, index);
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl multiset mkmultiset(array a) *! *! This function creates a multiset from an array. *! *! @seealso *! @[aggregate_multiset()] *! */
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) PIKEFUN multiset(1) mkmultiset(array(1=mixed) a) efun;
8f998d2000-08-31Henrik Grubbström (Grubba)  optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND;
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) { RETURN mkmultiset(a); }
50d97a2003-02-01Martin Stjernholm /*! @decl int trace(int level, void|string facility, void|int all_threads)
0498332001-02-10Henrik Grubbström (Grubba)  *!
50d97a2003-02-01Martin Stjernholm  *! This function changes the trace level for the subsystem identified *! by @[facility] to @[level]. If @[facility] is zero or left out, it *! changes the global trace level which affects all subsystems.
0498332001-02-10Henrik Grubbström (Grubba)  *!
50d97a2003-02-01Martin Stjernholm  *! Enabling tracing causes messages to be printed to stderr. A higher *! trace level includes the output from all lower levels. The lowest *! level is zero which disables all trace messages.
0498332001-02-10Henrik Grubbström (Grubba)  *! *! See the @tt{-t@} command-line option for more information.
6198092003-01-08Martin Stjernholm  *!
50d97a2003-02-01Martin Stjernholm  *! @param level *! If @[facility] is specified then there is typically only one *! trace level for it, i.e. it's an on-or-off toggle. The global *! trace levels, when @[facility] isn't specified, are: *! *! @int
2fe0542003-02-01Martin Stjernholm  *! @value 1
50d97a2003-02-01Martin Stjernholm  *! Trace calls to Pike functions and garbage collector runs.
2fe0542003-02-01Martin Stjernholm  *! @value 2
50d97a2003-02-01Martin Stjernholm  *! Trace calls to builtin functions.
2fe0542003-02-01Martin Stjernholm  *! @value 3
50d97a2003-02-01Martin Stjernholm  *! Trace every interpreted opcode.
2fe0542003-02-01Martin Stjernholm  *! @value 4
50d97a2003-02-01Martin Stjernholm  *! Also trace the opcode arguments. *! @endint *! *! @param facility *! Valid facilities are: *! *! @string
2fe0542003-02-01Martin Stjernholm  *! @value "gc"
50d97a2003-02-01Martin Stjernholm  *! Trace the start and end of each run of the garbage collector. *! The setting is never thread local. *! @endstring
6198092003-01-08Martin Stjernholm  *! *! @param all_threads
50d97a2003-02-01Martin Stjernholm  *! Trace levels are normally thread local, so changes affect only *! the current thread. To change the level in all threads, pass a *! nonzero value in this argument.
6198092003-01-08Martin Stjernholm  *! *! @returns
50d97a2003-02-01Martin Stjernholm  *! The old trace level in the current thread is returned.
0498332001-02-10Henrik Grubbström (Grubba)  */
50d97a2003-02-01Martin Stjernholm PIKEFUN int trace(int level, void|string facility, void|int all_threads)
098c802000-05-24Fredrik Hübinette (Hubbe)  efun; optflags OPT_SIDE_EFFECT; {
50d97a2003-02-01Martin Stjernholm  INT32 old_level; if (facility) { struct pike_string *gc_str; if (facility->type != T_STRING) SIMPLE_BAD_ARG_ERROR("trace", 2, "void|string");
de56ec2003-02-08Martin Stjernholm  MAKE_CONST_STRING(gc_str, "gc");
50d97a2003-02-01Martin Stjernholm  if (facility->u.string == gc_str) { old_level = gc_trace; gc_trace = level; } else { bad_arg_error("trace", Pike_sp-args, args, 2, "trace facility identifier", Pike_sp-args+1, "Bad argument 2 to trace(). Unknown trace facility."); }
6198092003-01-08Martin Stjernholm  }
50d97a2003-02-01Martin Stjernholm  else { old_level = Pike_interpreter.trace_level; gc_trace = level; #ifdef PIKE_THREADS if (!all_threads || UNSAFE_IS_ZERO (all_threads)) Pike_interpreter.trace_level = level; else { struct thread_state *s; FOR_EACH_THREAD(s, s->state.trace_level = level); }
6198092003-01-08Martin Stjernholm #else
50d97a2003-02-01Martin Stjernholm  Pike_interpreter.trace_level = level;
6198092003-01-08Martin Stjernholm #endif
50d97a2003-02-01Martin Stjernholm  } RETURN old_level;
098c802000-05-24Fredrik Hübinette (Hubbe) }
51adb82003-01-12Martin Stjernholm /*! @decl mapping(string:float) gc_parameters (void|mapping(string:mixed) params) *! @belongs Pike *! *! Set and get various parameters that control the operation of the *! garbage collector. The passed mapping contains the parameters to *! set. If a parameter is missing from the mapping, the current value *! will be filled in instead. The same mapping is returned. Thus an *! empty mapping, or no argument at all, causes a mapping with all *! current settings to be returned. *! *! The following parameters are recognized: *! *! @mapping *! @member int "enabled"
0d9f932003-01-14Martin Stjernholm  *! If this is 1 then the gc is enabled as usual. If it's 0 then all *! automatically scheduled gc runs are disabled and the parameters *! below have no effect, but explicit runs through the @[gc] *! function still works as usual. If it's -1 then the gc is *! completely disabled so that even explicit @[gc] calls won't do *! anything.
51adb82003-01-12Martin Stjernholm  *! @member float "garbage_ratio_low" *! As long as the gc time is less than gc_time_ratio, aim to run *! the gc approximately every time the ratio between the garbage *! and the total amount of allocated things is this. *! @member float "time_ratio" *! When more than this fraction of the cpu time is spent in the gc, *! aim for gc_garbage_ratio_high instead of gc_garbage_ratio_low. *! @member float "garbage_ratio_high" *! Upper limit for the garbage ratio - run the gc as often as it *! takes to keep it below this. *! @member float "average_slowness" *! When predicting the next gc interval, use a decaying average *! with this slowness factor. It should be a value between 0.0 and *! 1.0 that specifies the weight to give to the old average value. *! The remaining weight up to 1.0 is given to the last reading. *! @endmapping *! *! @seealso *! @[gc], @[Debug.gc_status] */ PIKEFUN mapping(string:mixed) gc_parameters (void|mapping(string:mixed) params) errname Pike.gc_parameters; optflags OPT_SIDE_EFFECT; { struct pike_string *str; struct svalue *set; struct svalue get; if (!params) { push_mapping (allocate_mapping (5)); params = Pike_sp - 1; } else if (params->type != T_MAPPING) SIMPLE_BAD_ARG_ERROR ("Pike.gc_parameters", 1, "void|mapping"); #define HANDLE_PARAM(NAME, CHECK_AND_SET, GET) do { \
de56ec2003-02-08Martin Stjernholm  MAKE_CONST_STRING (str, NAME); \
51adb82003-01-12Martin Stjernholm  if ((set = low_mapping_string_lookup (params->u.mapping, str))) { \ CHECK_AND_SET; \ } \ else { \ GET; \ mapping_string_insert (params->u.mapping, str, &get); \ } \ } while (0) #define HANDLE_FLOAT_FACTOR(NAME, VAR) \ HANDLE_PARAM (NAME, { \ if (set->type != T_FLOAT || \ set->u.float_number < 0.0 || set->u.float_number > 1.0) \ SIMPLE_BAD_ARG_ERROR ("Pike.gc_parameters", 1, \
0d9f932003-01-14Martin Stjernholm  "float between 0.0 and 1.0 for " NAME); \
51adb82003-01-12Martin Stjernholm  VAR = set->u.float_number; \ }, { \ get.type = T_FLOAT; \ get.u.float_number = VAR; \ }); HANDLE_PARAM ("enabled", {
0d9f932003-01-14Martin Stjernholm  if (set->type != T_INT || set->u.integer < -1 || set->u.integer > 1) SIMPLE_BAD_ARG_ERROR ("Pike.gc_parameters", 1, "integer in the range -1..1 for 'enabled'"); if (gc_enabled != set->u.integer) {
bbd8162003-01-15Martin Stjernholm  if (gc_enabled > 0)
0d9f932003-01-14Martin Stjernholm  gc_enabled = set->u.integer;
51adb82003-01-12Martin Stjernholm  else { gc_enabled = 1;
bbd8162003-01-15Martin Stjernholm  if (alloc_threshold == GC_MAX_ALLOC_THRESHOLD) alloc_threshold = GC_MIN_ALLOC_THRESHOLD;
51adb82003-01-12Martin Stjernholm  } } }, { get.type = T_INT; get.u.integer = gc_enabled; }); HANDLE_FLOAT_FACTOR ("garbage_ratio_low", gc_garbage_ratio_low); HANDLE_FLOAT_FACTOR ("time_ratio", gc_time_ratio); HANDLE_FLOAT_FACTOR ("garbage_ratio_high", gc_garbage_ratio_high); HANDLE_FLOAT_FACTOR ("average_slowness", gc_average_slowness); #undef HANDLE_PARAM #undef HANDLE_FLOAT_FACTOR REF_RETURN params->u.mapping; }
d6fd962001-02-10Henrik Grubbström (Grubba) /*! @decl string ctime(int timestamp) *!
0498332001-02-10Henrik Grubbström (Grubba)  *! Convert the output from a previous call to @[time()] into a readable *! string containing the current year, month, day and time. *!
f917a32002-10-03Martin Stjernholm  *! Like @[localtime], this function might throw an error if the *! ctime(2) call failed on the system. It's platform dependent what *! time ranges that function can handle, e.g. Windows doesn't handle *! a negative @[timestamp].
21f3f62002-10-03Martin Stjernholm  *!
0498332001-02-10Henrik Grubbström (Grubba)  *! @seealso *! @[time()], @[localtime()], @[mktime()], @[gmtime()] */
b0f8352001-01-07Henrik Grubbström (Grubba) PIKEFUN string ctime(int timestamp)
098c802000-05-24Fredrik Hübinette (Hubbe)  efun; optflags OPT_TRY_OPTIMIZE; {
b0f8352001-01-07Henrik Grubbström (Grubba)  time_t i=(time_t)timestamp;
21f3f62002-10-03Martin Stjernholm  char *s = ctime (&i);
f917a32002-10-03Martin Stjernholm  if (!s) Pike_error ("ctime() on this system cannot handle " "the timestamp %ld.\n", (long) i);
21f3f62002-10-03Martin Stjernholm  RETURN make_shared_string(s);
098c802000-05-24Fredrik Hübinette (Hubbe) }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl mapping mkmapping(array ind, array val) *! *! Make a mapping from two arrays. *! *! Makes a mapping @[ind[x]]:@[val[x]], @tt{0 <= x < sizeof(ind)@}. *! *! @[ind] and @[val] must have the same size. *! *! This is the inverse operation of @[indices()] and @[values()]. *! *! @seealso *! @[indices()], @[values()] */
b0f8352001-01-07Henrik Grubbström (Grubba) PIKEFUN mapping(1:2) mkmapping(array(1=mixed) ind, array(2=mixed) val)
098c802000-05-24Fredrik Hübinette (Hubbe)  efun;
8f998d2000-08-31Henrik Grubbström (Grubba)  optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND;
098c802000-05-24Fredrik Hübinette (Hubbe) {
b0f8352001-01-07Henrik Grubbström (Grubba)  if(ind->size != val->size)
cbaa3a2002-05-24Henrik Grubbström (Grubba)  bad_arg_error("mkmapping", Pike_sp-args, args, 2, "array", Pike_sp+1-args,
098c802000-05-24Fredrik Hübinette (Hubbe)  "mkmapping called on arrays of different sizes (%d != %d)\n",
b0f8352001-01-07Henrik Grubbström (Grubba)  ind->size, val->size);
098c802000-05-24Fredrik Hübinette (Hubbe) 
b0f8352001-01-07Henrik Grubbström (Grubba)  RETURN mkmapping(ind, val);
098c802000-05-24Fredrik Hübinette (Hubbe) }
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) 
31acb72001-07-26Martin Nilsson /*! @decl int count(string haystack, string needle) *! @belongs String
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Count the number of non-overlapping times the string @[needle] occurrs *! in the string @[haystack]. *! *! @seealso *! @[search()], @[`/()] */
6613052000-08-10Henrik Grubbström (Grubba) PIKEFUN int string_count(string haystack, string needle)
991fdf2000-05-25Fredrik Hübinette (Hubbe)  errname String.count; optflags OPT_TRY_OPTIMIZE; {
89fc4c2000-08-10Henrik Grubbström (Grubba)  ptrdiff_t c = 0; ptrdiff_t i, j;
991fdf2000-05-25Fredrik Hübinette (Hubbe)  switch (needle->len) { case 0: switch (haystack->len) { case 0: c=1; break; /* "" appears one time in "" */ case 1: c=0; break; /* "" doesn't appear in "x" */ default: c=haystack->len-1; /* one time between each character */ } break; case 1: /* maybe optimize? */ default: for (i=0; i<haystack->len; i++) { j=string_search(haystack,needle,i); if (j==-1) break; i=j+needle->len-1; c++; } break; }
6613052000-08-10Henrik Grubbström (Grubba)  RETURN DO_NOT_WARN((INT_TYPE)c);
991fdf2000-05-25Fredrik Hübinette (Hubbe) }
31acb72001-07-26Martin Nilsson /*! @decl string trim_whites (string s) *! @belongs String
5117f12001-04-16Martin Stjernholm  *! *! Trim leading and trailing spaces and tabs from the string @[s]. */ PIKEFUN string string_trim_whites (string s) errname String.trim_whites; optflags OPT_TRY_OPTIMIZE; { ptrdiff_t start = 0, end = s->len; int chr; switch (s->size_shift) { #define DO_IT(TYPE) \ { \ for (; start < s->len; start++) { \ chr = ((TYPE *) s->str)[start]; \ if (chr != ' ' && chr != '\t') break; \ } \ while (--end > start) { \ chr = ((TYPE *) s->str)[end]; \ if (chr != ' ' && chr != '\t') break; \ } \ } case 0: DO_IT (p_wchar0); break; case 1: DO_IT (p_wchar1); break; case 2: DO_IT (p_wchar2); break; #undef DO_IT } RETURN string_slice (s, start, end + 1 - start); }
31acb72001-07-26Martin Nilsson /*! @decl string trim_all_whites (string s) *! @belongs String
5117f12001-04-16Martin Stjernholm  *! *! Trim leading and trailing white spaces characters (space, tab, *! newline and carriage return) from the string @[s]. */ PIKEFUN string string_trim_all_whites (string s) errname String.trim_all_whites; optflags OPT_TRY_OPTIMIZE; { ptrdiff_t start = 0, end = s->len; int chr; switch (s->size_shift) { #define DO_IT(TYPE) \ { \ for (; start < s->len; start++) { \ chr = ((TYPE *) s->str)[start]; \ if (chr != ' ' && chr != '\t' && chr != '\n' && chr != '\r') \ break; \ } \ while (--end > start) { \ chr = ((TYPE *) s->str)[end]; \ if (chr != ' ' && chr != '\t' && chr != '\n' && chr != '\r') \ break; \ } \ } case 0: DO_IT (p_wchar0); break; case 1: DO_IT (p_wchar1); break; case 2: DO_IT (p_wchar2); break; #undef DO_IT } RETURN string_slice (s, start, end + 1 - start); }
31acb72001-07-26Martin Nilsson /*! @decl int implements(program prog, program api) *! @belongs Program
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Returns 1 if @[prog] implements @[api]. */
b0f8352001-01-07Henrik Grubbström (Grubba) PIKEFUN int program_implements(program prog, program api)
991fdf2000-05-25Fredrik Hübinette (Hubbe)  errname Program.implements; optflags OPT_TRY_OPTIMIZE; {
b0f8352001-01-07Henrik Grubbström (Grubba)  RETURN implements(prog, api);
991fdf2000-05-25Fredrik Hübinette (Hubbe) }
31acb72001-07-26Martin Nilsson /*! @decl int inherits(program child, program parent) *! @belongs Program
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Returns 1 if @[child] has inherited @[parent]. */
f3c7152001-04-14Fredrik Hübinette (Hubbe) PIKEFUN int program_inherits(program parent, program child)
991fdf2000-05-25Fredrik Hübinette (Hubbe)  errname Program.inherits; optflags OPT_TRY_OPTIMIZE; {
f3c7152001-04-14Fredrik Hübinette (Hubbe)  RETURN low_get_storage(parent, child) != -1;
991fdf2000-05-25Fredrik Hübinette (Hubbe) }
31acb72001-07-26Martin Nilsson /*! @decl string defined(program p) *! @belongs Program
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Returns a string with filename and linenumber describing where *! the program @[p] was defined. *!
cbe8c92003-04-07Martin Nilsson  *! The returned string is of the format @expr{"filename:linenumber"@}.
0498332001-02-10Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! If it cannot be determined where the program was defined, @expr{0@} *! (zero) will be returned.
0498332001-02-10Henrik Grubbström (Grubba)  */
b8c5b22000-05-25Fredrik Hübinette (Hubbe) PIKEFUN string program_defined(program p) errname Program.defined; optflags OPT_TRY_OPTIMIZE; {
9de5ff2002-12-01Martin Stjernholm  INT32 line; struct pike_string *tmp = low_get_program_line(p, &line);
b8c5b22000-05-25Fredrik Hübinette (Hubbe) 
9de5ff2002-12-01Martin Stjernholm  pop_n_elems(args);
50edc82001-07-13Henrik Grubbström (Grubba) 
9de5ff2002-12-01Martin Stjernholm  if (tmp) {
50edc82001-07-13Henrik Grubbström (Grubba)  push_string(tmp); if(line >= 1) { push_constant_text(":"); push_int(line); f_add(3);
b8c5b22000-05-25Fredrik Hübinette (Hubbe)  } }
9de5ff2002-12-01Martin Stjernholm  else push_int(0);
b8c5b22000-05-25Fredrik Hübinette (Hubbe) }
31acb72001-07-26Martin Nilsson /*! @decl int(8..8)|int(16..16)|int(32..32) width(string s) *! @belongs String
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Returns the width of a string. *! *! Three return values are possible: *! @int *! @value 8 *! The string @[s] only contains characters <= 255. *! @value 16 *! The string @[s] only contains characters <= 65535. *! @value 32 *! The string @[s] contains characters >= 65536. *! @endint */
d6fd962001-02-10Henrik Grubbström (Grubba) PIKEFUN int(8 .. 8)|int(16 .. 16)|int(32 .. 32) string_width(string s)
991fdf2000-05-25Fredrik Hübinette (Hubbe)  errname String.width; optflags OPT_TRY_OPTIMIZE; { RETURN 8 * (1 << s->size_shift); }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl mixed m_delete(object|mapping map, mixed index) *! *! If @[map] is an object that implements @[lfun::_m_delete()],
dd5cba2003-02-10Marek Habersack  *! that function will be called with @[index] as its single argument.
0498332001-02-10Henrik Grubbström (Grubba)  *!
dd5cba2003-02-10Marek Habersack  *! Otherwise if @[map] is a mapping the entry with index @[index]
0498332001-02-10Henrik Grubbström (Grubba)  *! will be removed from @[map] destructively. *! *! If the mapping does not have an entry with index @[index], nothing is done. *! *! @returns
52ced62003-02-11Henrik Grubbström (Grubba)  *! The value that was removed will be returned.
0498332001-02-10Henrik Grubbström (Grubba)  *! *! @note *! Note that @[m_delete()] changes @[map] destructively. *! *! @seealso *! @[mappingp()] */
a3453e2001-02-05Per Hedbor PIKEFUN mixed m_delete(object|mapping map, mixed index)
7f80d42000-06-19Fredrik Hübinette (Hubbe)  efun; optflags OPT_SIDE_EFFECT; {
a3453e2001-02-05Per Hedbor  /*FIXME: Should be * type function(mapping(1=mixed:2=mixed),1:2)| * function(object,mixed:mixed); * * or similar */ if( map->type == T_MAPPING ) { struct svalue s; map_delete_no_free(map->u.mapping, index, &s); pop_n_elems(args);
cbaa3a2002-05-24Henrik Grubbström (Grubba)  *Pike_sp=s; Pike_sp++;
cdf18a2003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
a3453e2001-02-05Per Hedbor  }
e9af832001-02-10Martin Stjernholm  else if (map->type == T_OBJECT && map->u.object->prog)
a3453e2001-02-05Per Hedbor  {
0498332001-02-10Henrik Grubbström (Grubba)  int id = FIND_LFUN(map->u.object->prog, LFUN__M_DELETE);
ea56012001-02-09Per Hedbor  if( id == -1 )
e786012003-02-11Marek Habersack  SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object containing the _m_delete method");
ea56012001-02-09Per Hedbor  apply_low( map->u.object, id, 1 );
a3453e2001-02-05Per Hedbor  stack_swap(); pop_stack();
79f6982001-02-05Henrik Grubbström (Grubba)  } else { SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object|mapping");
a3453e2001-02-05Per Hedbor  }
7f80d42000-06-19Fredrik Hübinette (Hubbe) }
9da7f42001-06-05Martin Stjernholm /*! @decl int get_weak_flag(array|mapping|multiset m)
0498332001-02-10Henrik Grubbström (Grubba)  *!
9da7f42001-06-05Martin Stjernholm  *! Returns the weak flag settings for @[m]. It's a combination of *! @[Pike.WEAK_INDICES] and @[Pike.WEAK_VALUES].
0498332001-02-10Henrik Grubbström (Grubba)  */
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN int get_weak_flag(array m)
ee9fa92000-07-06Martin Stjernholm  efun;
8f998d2000-08-31Henrik Grubbström (Grubba)  optflags OPT_EXTERNAL_DEPEND;
ee9fa92000-07-06Martin Stjernholm {
e1b4192001-06-06Fredrik Hübinette (Hubbe)  RETURN (m->flags & ARRAY_WEAK_FLAG) ? PIKE_WEAK_VALUES : 0; } PIKEFUN int get_weak_flag(mapping m) { RETURN mapping_get_flags(m) & MAPPING_WEAK; } PIKEFUN int get_weak_flag(multiset m) {
5b15bb2001-12-10Martin Stjernholm #ifdef PIKE_NEW_MULTISETS RETURN multiset_get_flags(m) & MULTISET_WEAK; #else
e1b4192001-06-06Fredrik Hübinette (Hubbe)  RETURN (m->ind->flags & (ARRAY_WEAK_FLAG|ARRAY_WEAK_SHRINK)) ?
9da7f42001-06-05Martin Stjernholm  PIKE_WEAK_INDICES : 0;
5b15bb2001-12-10Martin Stjernholm #endif
ee9fa92000-07-06Martin Stjernholm }
18c2252003-04-10Martin Nilsson /*! @decl program __empty_program(int|void line, string|void file) */
9de5ff2002-12-01Martin Stjernholm PIKEFUN program __empty_program(int|void line, string|void file)
aa68b12001-03-19Fredrik Hübinette (Hubbe)  efun; optflags OPT_EXTERNAL_DEPEND; {
9de5ff2002-12-01Martin Stjernholm  if (line && line->type != T_INT) SIMPLE_BAD_ARG_ERROR("__empty_program", 1, "int|void"); else if (file && file->type != T_STRING) SIMPLE_BAD_ARG_ERROR("__empty_program", 2, "string|void"); else { struct program *prog = low_allocate_program(); if (file) ext_store_program_line (prog, line->u.integer, file->u.string); RETURN prog; }
aa68b12001-03-19Fredrik Hübinette (Hubbe) }
1c1c5e2001-04-08Fredrik Hübinette (Hubbe) /*! @decl string function_name(function f) *! *! Return the name of the function @[f]. *!
cbe8c92003-04-07Martin Nilsson  *! If @[f] is a global function defined in the runtime @expr{0@} *! (zero) will be returned.
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *! *! @seealso *! @[function_object()] */ PIKEFUN string function_name(program|function func) efun; optflags OPT_TRY_OPTIMIZE; { switch(func->type) { default:
d4ecd72003-01-05Martin Nilsson  SIMPLE_BAD_ARG_ERROR("function_name", 1, "function|program");
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  return; /* NOTREACHED */ case PIKE_T_PROGRAM: { struct program *p=func->u.program; if(p->parent) { int e; p=p->parent; /* search constants in parent for this * program... */ for(e = p->num_identifier_references; e--; ) { struct identifier *id; if (p->identifier_references[e].id_flags & ID_HIDDEN) continue; id = ID_FROM_INT(p, e); if (IDENTIFIER_IS_CONSTANT(id->identifier_flags) && is_eq( & PROG_FROM_INT(p, e)->constants[id->func.offset].sval, func)) REF_RETURN id->name; }
52ced62003-02-11Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (d_flag>5) { fprintf(stderr,
2523ce2003-04-28Martin Stjernholm  "Failed to find symbol for program %p\n"
52ced62003-02-11Henrik Grubbström (Grubba)  "Parent program info:\n", func->u.program); dump_program_tables(func->u.program->parent, 0); } #endif
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  } break; } case PIKE_T_FUNCTION: if(func->subtype == FUNCTION_BUILTIN) break; if(!func->u.object->prog) bad_arg_error("function_name", Pike_sp-args, args, 1, "function", Pike_sp-args, "Destructed object.\n");
5a6d7d2001-04-10Fredrik Hübinette (Hubbe)  if(func->u.object->prog == pike_trampoline_program) { struct pike_trampoline *t; t=((struct pike_trampoline *)func->u.object->storage); if(t->frame->current_object->prog) REF_RETURN ID_FROM_INT(t->frame->current_object->prog, t->func)->name; }
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  REF_RETURN ID_FROM_INT(func->u.object->prog, func->subtype)->name; } pop_n_elems(args); push_int(0); }
6410612003-01-08Henrik Grubbström (Grubba) /*! @decl object function_object(function f)
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *!
6410612003-01-08Henrik Grubbström (Grubba)  *! Return the object the function @[f] is in.
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *!
cbe8c92003-04-07Martin Nilsson  *! If @[f] is a global function defined in the runtime @expr{0@} *! (zero) will be returned.
6410612003-01-08Henrik Grubbström (Grubba)  *! *! Zero will also be returned if @[f] is a constant in the *! parent class. In that case @[function_program()] can be *! used to get the parent program.
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *! *! @seealso
6410612003-01-08Henrik Grubbström (Grubba)  *! @[function_name()], @[function_program()]
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  */
51adb82003-01-12Martin Stjernholm PIKEFUN object function_object(function|program func)
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  efun; optflags OPT_TRY_OPTIMIZE;
6410612003-01-08Henrik Grubbström (Grubba)  type function(function:object);
1c1c5e2001-04-08Fredrik Hübinette (Hubbe) { switch(func->type) { case PIKE_T_PROGRAM:
6410612003-01-08Henrik Grubbström (Grubba)  break;
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  case PIKE_T_FUNCTION: if(func->subtype == FUNCTION_BUILTIN) break;
5a6d7d2001-04-10Fredrik Hübinette (Hubbe)  if(func->u.object->prog == pike_trampoline_program) { struct object *o; o=((struct pike_trampoline *)func->u.object->storage)->frame->current_object; add_ref(o); pop_n_elems(args); push_object(o); return; }
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  func->type=T_OBJECT; return;
5a6d7d2001-04-10Fredrik Hübinette (Hubbe)  default: SIMPLE_BAD_ARG_ERROR("function_object",1,"function");
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  } pop_n_elems(args); push_int(0); }
6410612003-01-08Henrik Grubbström (Grubba) /*! @decl program function_program(function|program f) *! *! Return the program the function @[f] is in. *!
cbe8c92003-04-07Martin Nilsson  *! If @[f] is a global function defined in the runtime @expr{0@} *! (zero) will be returned.
6410612003-01-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[function_name()], @[function_object()] */ PIKEFUN program function_program(program|function func) efun; optflags OPT_TRY_OPTIMIZE; { switch(func->type) { case PIKE_T_PROGRAM: { struct program *p; if(!(p=func->u.program->parent)) break; add_ref(p); free_program(func->u.program); func->u.program=p; return; } case PIKE_T_FUNCTION: { struct program *p; if(func->subtype == FUNCTION_BUILTIN) break; p = func->u.object->prog; if(p == pike_trampoline_program) { p = ((struct pike_trampoline *)func->u.object->storage)-> frame->current_object->prog; } if (p) { ref_push_program(p); stack_pop_n_elems_keep_top(args); return; } } break; default: SIMPLE_BAD_ARG_ERROR("function_program", 1, "function"); } pop_n_elems(args); push_int(0); }
1c1c5e2001-04-08Fredrik Hübinette (Hubbe) 
18c2252003-04-10Martin Nilsson /*! @decl mixed random(object o) *! If random is called with an object, @[lfun::random] will be *! called in the object.
d95fa82001-06-05Fredrik Hübinette (Hubbe)  *! @seealso
18c2252003-04-10Martin Nilsson  *! @[lfun::_random]
d95fa82001-06-05Fredrik Hübinette (Hubbe)  */
e1b4192001-06-06Fredrik Hübinette (Hubbe) 
18c2252003-04-10Martin Nilsson /*! @decl mixed lfun::_random() *! Called by @[random]. Typical uses is when the object implements *! a ADT, then a call to this lfun should return a random member of *! the ADT or range implied by the ADT. *! @seealso *! @[predef::random()] */
e1b4192001-06-06Fredrik Hübinette (Hubbe)  PIKEFUN mixed random(object o)
d95fa82001-06-05Fredrik Hübinette (Hubbe)  efun; optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND; {
e1b4192001-06-06Fredrik Hübinette (Hubbe)  apply(o,"_random",0); stack_swap(); pop_stack(); }
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
18c2252003-04-10Martin Nilsson /*! @decl int random(int max) *! @decl float random(float max) *! *! This function returns a random number in the range 0 - @[max]-1. *! *! @seealso *! @[random_seed()] */
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN int random(int i) { if(i <= 0) RETURN 0; RETURN my_rand() % i; } PIKEFUN float random(float f) { if(f<=0.0) RETURN 0.0;
d95fa82001-06-05Fredrik Hübinette (Hubbe) #define N 1048576
e1b4192001-06-06Fredrik Hübinette (Hubbe)  RETURN f * (my_rand()%N/((float)N)) + f * (my_rand()%N/( ((float)N) * ((float)N) ));
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
e1b4192001-06-06Fredrik Hübinette (Hubbe) }
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
18c2252003-04-10Martin Nilsson /*! @decl mixed random(array|multiset xa) *! Returns a random element from @[x]. */
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN mixed random(array a) { if(!a->size) SIMPLE_BAD_ARG_ERROR("random", 1, "array with elements in it"); push_svalue(a->item + (my_rand() % a->size)); stack_swap(); pop_stack(); }
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN mixed random(multiset m) {
5b15bb2001-12-10Martin Stjernholm  if(multiset_is_empty (m))
e1b4192001-06-06Fredrik Hübinette (Hubbe)  SIMPLE_BAD_ARG_ERROR("random", 1, "multiset with elements in it");
5b15bb2001-12-10Martin Stjernholm #ifdef PIKE_NEW_MULTISETS if (multiset_indval (m)) { ptrdiff_t nodepos = multiset_get_nth (m, my_rand() % multiset_sizeof (m)); push_multiset_index (m, nodepos); push_multiset_value (m, nodepos); sub_msnode_ref (m); f_aggregate (2); } else { push_multiset_index (m, multiset_get_nth (m, my_rand() % multiset_sizeof (m))); sub_msnode_ref (m); } #else
e1b4192001-06-06Fredrik Hübinette (Hubbe)  push_svalue(m->ind->item + (my_rand() % m->ind->size));
5b15bb2001-12-10Martin Stjernholm #endif
e1b4192001-06-06Fredrik Hübinette (Hubbe)  stack_swap(); pop_stack(); }
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
18c2252003-04-10Martin Nilsson /*! @decl array random(mapping m) *! Returns a random index-value pair from the mapping. */
5b15bb2001-12-10Martin Stjernholm PIKEFUN array random(mapping m)
e1b4192001-06-06Fredrik Hübinette (Hubbe) { struct mapping_data *md=m->data; size_t bucket, count; struct keypair *k; if(!m_sizeof(m)) SIMPLE_BAD_ARG_ERROR("random", 1, "mapping with elements in it"); /* Find a random, nonempty bucket */ bucket=my_rand() % md->hashsize; while(! md->hash[bucket] ) if(++bucket > (size_t)md->hashsize) bucket=0; /* Count entries in bucket */ count=0; for(k=md->hash[bucket];k;k=k->next) count++; /* Select a random entry in this bucket */ count = my_rand() % count; k=md->hash[bucket]; while(count-- > 0) k=k->next; /* Push result and return */ push_svalue(&k->ind); push_svalue(&k->val); f_aggregate(2); stack_swap(); pop_stack();
d95fa82001-06-05Fredrik Hübinette (Hubbe) }
d27df52001-06-18Henrik Grubbström (Grubba) /* * Backtrace handling. */
bcbce02001-08-15Martin Nilsson /*! @module Pike */
b6b1162018-12-18Henrik Grubbström (Grubba) /*! @class FakeObject *! *! Used as a place holder in eg backtraces for objects that *! are unsuitable to have references to in backtraces. *! *! Examples of such objects are instances of @[Thread.MutexKey], *! and @[Nettle.Cipher.State]. *! *! @seealso *! @[backtrace()] */ PIKECLASS FakeObject program_flags PROGRAM_CONSTANT; { PIKEVAR program prog flags ID_PRIVATE|ID_PROTECTED|ID_HIDDEN;
05afec2019-09-04Henrik Grubbström (Grubba)  PIKEVAR string description flags ID_PROTECTED;
b6b1162018-12-18Henrik Grubbström (Grubba) 
05afec2019-09-04Henrik Grubbström (Grubba)  PIKEFUN void create(program|function|void prog, string|void description)
b6b1162018-12-18Henrik Grubbström (Grubba)  flags ID_PROTECTED; { struct program *p = prog ? program_from_svalue(prog):NULL; do_free_program(THIS->prog); THIS->prog = p; if (p) add_ref(p);
05afec2019-09-04Henrik Grubbström (Grubba)  if (THIS->description) free_string(THIS->description); if ((THIS->description = description)) { add_ref(THIS->description); }
b6b1162018-12-18Henrik Grubbström (Grubba)  } PIKEFUN string _sprintf(int c, mapping|void ignored) flags ID_PROTECTED; {
05afec2019-09-04Henrik Grubbström (Grubba)  if ((c == 'O') && THIS->description) { ref_push_string(THIS->description); return; }
b6b1162018-12-18Henrik Grubbström (Grubba)  push_text("%O()"); if (THIS->prog) { ref_push_program(THIS->prog); } else { ref_push_program(Pike_fp->current_program); } f_sprintf(2); } } /*! @endclass */
05afec2019-09-04Henrik Grubbström (Grubba) static struct object *clone_fake_object(struct object *o)
b6b1162018-12-18Henrik Grubbström (Grubba) {
05afec2019-09-04Henrik Grubbström (Grubba)  struct program *p = o?o->prog:NULL; if (p) { ref_push_program(p); if (FIND_LFUN(p, LFUN__SPRINTF) != -1) { push_int('O'); apply_lfun(o, LFUN__SPRINTF, 1); return clone_object(FakeObject_program, 2); } } else { push_undefined(); }
b6b1162018-12-18Henrik Grubbström (Grubba)  return clone_object(FakeObject_program, 1); }
d27df52001-06-18Henrik Grubbström (Grubba) /*! @class BacktraceFrame */ PIKECLASS backtrace_frame {
f61a482001-06-19Henrik Grubbström (Grubba)  PIKEVAR mixed fun;
2aca9f2001-06-19Henrik Grubbström (Grubba)  PIKEVAR array args;
73b08f2003-01-31Martin Stjernholm  /* These are cleared when filename and lineno has been initialized * from them. */
de395b2001-06-19Henrik Grubbström (Grubba)  CVAR struct program *prog; /* FIXME: Ought to be a private pikevar... */
90f8762002-04-08Martin Stjernholm  CVAR PIKE_OPCODE_T *pc;
73b08f2003-01-31Martin Stjernholm  /* These two are considered to be uninitialized from prog, pc and * fun as long as lineno == -1. */
d27df52001-06-18Henrik Grubbström (Grubba)  CVAR struct pike_string *filename;
69aa4b2003-01-26Mirar (Pontus Hagland)  CVAR INT32 lineno;
d27df52001-06-18Henrik Grubbström (Grubba)  INIT {
0f47db2001-06-19Henrik Grubbström (Grubba)  THIS->fun.type = T_INT;
f61a482001-06-19Henrik Grubbström (Grubba)  THIS->fun.u.integer = 0;
0f47db2001-06-19Henrik Grubbström (Grubba)  THIS->prog = NULL;
90f8762002-04-08Martin Stjernholm  THIS->pc = NULL;
73b08f2003-01-31Martin Stjernholm  THIS->lineno = -1;
0f47db2001-06-19Henrik Grubbström (Grubba)  THIS->args = NULL; THIS->filename = NULL;
d27df52001-06-18Henrik Grubbström (Grubba)  } EXIT {
0f47db2001-06-19Henrik Grubbström (Grubba)  if (THIS->prog) { free_program(THIS->prog); THIS->prog = NULL; } if (THIS->args) { free_array(THIS->args); THIS->args = NULL;
d27df52001-06-18Henrik Grubbström (Grubba)  } if (THIS->filename) { free_string(THIS->filename);
0f47db2001-06-19Henrik Grubbström (Grubba)  THIS->filename = NULL;
d27df52001-06-18Henrik Grubbström (Grubba)  }
1073bf2001-06-26Henrik Grubbström (Grubba)  THIS->pc = NULL;
73b08f2003-01-31Martin Stjernholm  THIS->lineno = -1;
0f47db2001-06-19Henrik Grubbström (Grubba)  free_svalue(&THIS->fun); THIS->fun.type = T_INT;
de395b2001-06-19Henrik Grubbström (Grubba)  THIS->fun.u.integer = 0;
d27df52001-06-18Henrik Grubbström (Grubba)  }
18c2252003-04-10Martin Nilsson  /*! @decl int(0..1) _is_type(string t) *! This object claims to be an array for backward compatibility. */
d2cd4e2001-06-18Henrik Grubbström (Grubba)  PIKEFUN int(0..1) _is_type(string t) { INT_TYPE res = (t == findstring("array")); pop_n_elems(args); push_int(res); }
73b08f2003-01-31Martin Stjernholm  static void fill_in_file_and_line() { struct pike_string *file; assert (THIS->lineno == -1); if (THIS->pc && THIS->prog) { file = low_get_line(THIS->pc, THIS->prog, &THIS->lineno); THIS->pc = NULL; } else if (THIS->fun.type == PIKE_T_FUNCTION) file = low_get_function_line (THIS->fun.u.object, THIS->fun.subtype, &THIS->lineno); else if (THIS->prog) file = low_get_program_line (THIS->prog, &THIS->lineno); if (!THIS->filename) THIS->filename = file; else free_string (file); if (THIS->prog) { free_program(THIS->prog); THIS->prog = NULL; } }
18c2252003-04-10Martin Nilsson  /*! @decl string _sprintf(int c, mapping|void opts) */
d27df52001-06-18Henrik Grubbström (Grubba)  PIKEFUN string _sprintf(int c, mapping|void opts) { pop_n_elems(args);
e6dbc22002-11-29Marcus Comstedt  if (c != 'O') { push_undefined (); return; }
d27df52001-06-18Henrik Grubbström (Grubba)  push_text("backtrace_frame(");
73b08f2003-01-31Martin Stjernholm  if (THIS->lineno == -1) fill_in_file_and_line();
1073bf2001-06-26Henrik Grubbström (Grubba)  if (THIS->filename) {
d27df52001-06-18Henrik Grubbström (Grubba)  ref_push_string(THIS->filename); push_text(":"); push_int(THIS->lineno); push_text(", "); f_add(4); } else { push_text("Unknown file, "); }
0f47db2001-06-19Henrik Grubbström (Grubba)  if (THIS->fun.type == PIKE_T_FUNCTION) { if (THIS->fun.u.object->prog) { push_svalue(&THIS->fun); f_function_name(1); push_text("(), "); f_add(2); } else { free_svalue(&THIS->fun); THIS->fun.type = PIKE_T_INT; THIS->fun.u.integer = 0; THIS->fun.subtype = NUMBER_DESTRUCTED; push_text("destructed_function(), "); }
d27df52001-06-18Henrik Grubbström (Grubba)  } else { push_text("destructed_function(), "); }
0f47db2001-06-19Henrik Grubbström (Grubba)  if (THIS->args) {
d27df52001-06-18Henrik Grubbström (Grubba)  push_text("Args: ");
0f47db2001-06-19Henrik Grubbström (Grubba)  push_int(THIS->args->size);
d27df52001-06-18Henrik Grubbström (Grubba)  f_add(2); } else { push_text("No args"); } push_text(")"); f_add(5); }
18c2252003-04-10Martin Nilsson  /*! @decl int(3..) _sizeof() */ PIKEFUN int(3..) _sizeof()
d27df52001-06-18Henrik Grubbström (Grubba)  {
0f47db2001-06-19Henrik Grubbström (Grubba)  if (THIS->args) { push_int(THIS->args->size + 3); } else { push_int(3);
d27df52001-06-18Henrik Grubbström (Grubba)  } }
18c2252003-04-10Martin Nilsson  /*! @decl mixed `[](int index, int|void end_or_none) *! The BacktraceFrame object can be indexed as an array. */
d2cd4e2001-06-18Henrik Grubbström (Grubba)  PIKEFUN mixed `[](int index, int|void end_or_none)
d27df52001-06-18Henrik Grubbström (Grubba)  {
d2cd4e2001-06-18Henrik Grubbström (Grubba)  INT_TYPE end = index; INT32 numargs = 0; INT32 i;
0f47db2001-06-19Henrik Grubbström (Grubba)  if (THIS->args) { numargs = THIS->args->size;
d27df52001-06-18Henrik Grubbström (Grubba)  }
d2cd4e2001-06-18Henrik Grubbström (Grubba)  numargs += 3; if (!end_or_none) { if (index < 0) { index_error("pike_frame->`[]", Pike_sp-args, args, NULL, Pike_sp-args, "Indexing with negative index (%"PRINTPIKEINT"d)\n", index); } else if (index >= numargs) { index_error("pike_frame->`[]", Pike_sp-args, args, NULL, Pike_sp-args, "Indexing with too large index (%"PRINTPIKEINT"d)\n", index); } } else { if (end_or_none->type != PIKE_T_INT) { SIMPLE_BAD_ARG_ERROR("`[]",2,"int|void"); } end = end_or_none->u.integer;
d27df52001-06-18Henrik Grubbström (Grubba)  } pop_n_elems(args);
d2cd4e2001-06-18Henrik Grubbström (Grubba)  if (end_or_none) {
0f47db2001-06-19Henrik Grubbström (Grubba)  if ((end < 0) || (end < index) || (index >= numargs)) {
d2cd4e2001-06-18Henrik Grubbström (Grubba)  f_aggregate(0); return;
d27df52001-06-18Henrik Grubbström (Grubba)  }
d2cd4e2001-06-18Henrik Grubbström (Grubba)  if (end >= numargs) { end = numargs-1;
d27df52001-06-18Henrik Grubbström (Grubba)  }
d2cd4e2001-06-18Henrik Grubbström (Grubba)  } for (i = index; i <= end; i++) { switch(i) { case 0: /* Filename */
73b08f2003-01-31Martin Stjernholm  if (THIS->lineno == -1) fill_in_file_and_line(); if (THIS->filename) { ref_push_string(THIS->filename);
d2cd4e2001-06-18Henrik Grubbström (Grubba)  } else {
73b08f2003-01-31Martin Stjernholm  push_int(0);
d2cd4e2001-06-18Henrik Grubbström (Grubba)  }
1073bf2001-06-26Henrik Grubbström (Grubba)  break;
73b08f2003-01-31Martin Stjernholm  case 1: /* Linenumber */ if (THIS->lineno == -1) fill_in_file_and_line(); push_int(THIS->lineno); break;
d2cd4e2001-06-18Henrik Grubbström (Grubba)  case 2: /* Function */
0f47db2001-06-19Henrik Grubbström (Grubba)  push_svalue(&THIS->fun);
d2cd4e2001-06-18Henrik Grubbström (Grubba)  break; default: /* Arguments */ {
0f47db2001-06-19Henrik Grubbström (Grubba)  if ((i > 2) && (THIS->args) && (i-3 < THIS->args->size)) { push_svalue(THIS->args->item + (i - 3));
d2cd4e2001-06-18Henrik Grubbström (Grubba)  break; } bad_arg_error("backtrace_frame->`[]", Pike_sp-args, args, 1, "int(0..)", Pike_sp-args, "Bad argument 1 to backtrace_frame->`[](): " "Expected int(0..%d)\n", numargs + 2); } /* NOT_REACHED */ break;
d27df52001-06-18Henrik Grubbström (Grubba)  }
d2cd4e2001-06-18Henrik Grubbström (Grubba)  } if (end_or_none) { f_aggregate(1 + end - index);
d27df52001-06-18Henrik Grubbström (Grubba)  } }
d2cd4e2001-06-18Henrik Grubbström (Grubba) 
18c2252003-04-10Martin Nilsson  /*! @decl mixed `[]=(int index, mixed value) */
1073bf2001-06-26Henrik Grubbström (Grubba)  PIKEFUN mixed `[]=(int index, mixed value) { INT32 numargs = 0; if (THIS->args) { numargs = THIS->args->size; } numargs += 3; if ((index < -numargs) || (index >= numargs)) { index_error("pike_frame->`[]=", Pike_sp-args, args, NULL, Pike_sp-args, "Index %"PRINTPIKEINT"d is out of array range 0 - %d,\n", index, numargs-1); } else if (index < 0) { index += numargs; } if (args > 2) { pop_n_elems(args - 2); args = 2; } switch(index) { case 0: /* Filename */
73b08f2003-01-31Martin Stjernholm  if (THIS->lineno == -1) fill_in_file_and_line(); if (value->type != PIKE_T_STRING) { if ((value->type != PIKE_T_INT) || (value->u.integer)) { SIMPLE_BAD_ARG_ERROR("backtrace_frame->`[]=", 2, "string|int(0..0)");
1073bf2001-06-26Henrik Grubbström (Grubba)  }
73b08f2003-01-31Martin Stjernholm  if (THIS->filename) { free_string(THIS->filename); THIS->filename = NULL;
1073bf2001-06-26Henrik Grubbström (Grubba)  } } else {
73b08f2003-01-31Martin Stjernholm  if (THIS->filename) { free_string(THIS->filename); THIS->filename = NULL;
1073bf2001-06-26Henrik Grubbström (Grubba)  }
73b08f2003-01-31Martin Stjernholm  copy_shared_string(THIS->filename, value->u.string);
1073bf2001-06-26Henrik Grubbström (Grubba)  } break;
73b08f2003-01-31Martin Stjernholm  case 1: /* Linenumber */ if (THIS->lineno == -1) fill_in_file_and_line(); if (value->type != PIKE_T_INT) { SIMPLE_BAD_ARG_ERROR("backtrace_frame->`[]=", 2, "int(1..)"); } THIS->lineno = value->u.integer; break;
1073bf2001-06-26Henrik Grubbström (Grubba)  case 2: /* Function */
73b08f2003-01-31Martin Stjernholm  if (THIS->lineno == -1) fill_in_file_and_line();
1073bf2001-06-26Henrik Grubbström (Grubba)  assign_svalue(&THIS->fun, value); break; default: /* Arguments */ assign_svalue(THIS->args->item + index - 3, value); break; } stack_swap(); pop_stack(); }
d27df52001-06-18Henrik Grubbström (Grubba) }; /*! @endclass */
bcbce02001-08-15Martin Nilsson /*! @endmodule */
a8e9892001-09-05Fredrik Hübinette (Hubbe) void low_backtrace(struct Pike_interpreter *i)
d27df52001-06-18Henrik Grubbström (Grubba) {
b85fa02003-02-24Martin Stjernholm  struct svalue *stack_top = i->stack_pointer;
c98dd22001-06-26Martin Stjernholm  struct pike_frame *f, *of = 0;
d27df52001-06-18Henrik Grubbström (Grubba)  int size = 0;
9906e32001-06-20Henrik Grubbström (Grubba)  struct array *res = NULL;
d27df52001-06-18Henrik Grubbström (Grubba) 
a8e9892001-09-05Fredrik Hübinette (Hubbe)  for (f = i->frame_pointer; f; f = f->next) {
9906e32001-06-20Henrik Grubbström (Grubba)  size++; } res = allocate_array_no_init(size, 0); push_array(res);
a8e9892001-09-05Fredrik Hübinette (Hubbe)  for (f = i->frame_pointer; f && size; f = (of = f)->next) {
d27df52001-06-18Henrik Grubbström (Grubba)  struct object *o = low_clone(backtrace_frame_program);
0f47db2001-06-19Henrik Grubbström (Grubba)  struct backtrace_frame_struct *bf;
e89d722002-01-04Henrik Grubbström (Grubba)  struct identifier *function = NULL;
0f47db2001-06-19Henrik Grubbström (Grubba) 
d27df52001-06-18Henrik Grubbström (Grubba)  call_c_initializers(o);
0f47db2001-06-19Henrik Grubbström (Grubba) 
9906e32001-06-20Henrik Grubbström (Grubba)  size--; res->item[size].u.object = o; res->item[size].type = PIKE_T_OBJECT; res->item[size].subtype = 0;
0f47db2001-06-19Henrik Grubbström (Grubba)  bf = OBJ2_BACKTRACE_FRAME(o); if ((bf->prog = f->context.prog)) { add_ref(bf->prog);
4db8f92002-04-28Martin Stjernholm  if (f->pc) {
dac8762002-05-11Martin Stjernholm  /* f->pc is the return address (i.e the next opcode) when * inside a call, otherwise it points to the current * opcode. */ if (of)
4db8f92002-04-28Martin Stjernholm  bf->pc = f->pc - 1; else bf->pc = f->pc; }
0f47db2001-06-19Henrik Grubbström (Grubba)  } if ((bf->fun.u.object = f->current_object) && (bf->fun.u.object->prog)) { add_ref(bf->fun.u.object); bf->fun.subtype = f->fun; bf->fun.type = PIKE_T_FUNCTION;
e89d722002-01-04Henrik Grubbström (Grubba)  function = ID_FROM_INT(f->current_object->prog, f->fun);
0f47db2001-06-19Henrik Grubbström (Grubba)  } else { bf->fun.u.integer = 0; bf->fun.subtype = NUMBER_DESTRUCTED; bf->fun.type = PIKE_T_INT; } if (f->locals) { INT32 numargs = DO_NOT_WARN((INT32) MINIMUM(f->num_args,
b85fa02003-02-24Martin Stjernholm  stack_top - f->locals));
e89d722002-01-04Henrik Grubbström (Grubba)  INT32 varargs = 0;
da90692002-11-26Henrik Grubbström (Grubba)  if(of) {
c98dd22001-06-26Martin Stjernholm  /* f->num_args can be too large, so this is necessary for some * reason. I don't know why. /mast */ numargs = DO_NOT_WARN((INT32)MINIMUM(f->num_args,of->locals - f->locals));
da90692002-11-26Henrik Grubbström (Grubba)  }
0f47db2001-06-19Henrik Grubbström (Grubba)  numargs = MAXIMUM(numargs, 0);
e89d722002-01-04Henrik Grubbström (Grubba)  /* Handle varargs... */ if (function && (function->identifier_flags & IDENTIFIER_VARARGS) &&
b85fa02003-02-24Martin Stjernholm  (f->locals + numargs < stack_top) &&
e89d722002-01-04Henrik Grubbström (Grubba)  (f->locals[numargs].type == T_ARRAY)) { varargs = f->locals[numargs].u.array->size; } if (numargs + varargs) { bf->args = allocate_array_no_init(numargs + varargs, 0);
2523ce2003-04-28Martin Stjernholm  bf->args->type_field = assign_svalues_no_free(bf->args->item, f->locals, numargs, BIT_MIXED);
e89d722002-01-04Henrik Grubbström (Grubba)  if (varargs) {
2523ce2003-04-28Martin Stjernholm  bf->args->type_field |= assign_svalues_no_free(bf->args->item + numargs, f->locals[numargs].u.array->item, varargs, BIT_MIXED);
e89d722002-01-04Henrik Grubbström (Grubba)  }
b6b1162018-12-18Henrik Grubbström (Grubba)  if (bf->args->type_field & BIT_OBJECT) { ptrdiff_t i; for (i = 0; i < bf->args->size; i++) { struct svalue *s = ITEM(bf->args) + i; if ((TYPEOF(*s) == T_OBJECT) && s->u.object->prog && (s->u.object->prog->flags & (PROGRAM_DESTRUCT_IMMEDIATE|PROGRAM_CLEAR_STORAGE))) { /* It is typically a bad idea to have extra references * to objects with these flags. The flags are usually * used by stuff like mutex keys and encryption keys * respectively. */
05afec2019-09-04Henrik Grubbström (Grubba)  struct object *o = clone_fake_object(s->u.object);
b6b1162018-12-18Henrik Grubbström (Grubba)  free_object(s->u.object); SET_SVAL(*s, T_OBJECT, 0, object, o); } } }
0f47db2001-06-19Henrik Grubbström (Grubba)  } }
d27df52001-06-18Henrik Grubbström (Grubba)  }
2523ce2003-04-28Martin Stjernholm  res->type_field = BIT_OBJECT;
9906e32001-06-20Henrik Grubbström (Grubba)  /* NOTE: res has already been pushed on the stack. */
d27df52001-06-18Henrik Grubbström (Grubba) }
e1b4192001-06-06Fredrik Hübinette (Hubbe) 
a8e9892001-09-05Fredrik Hübinette (Hubbe) /*! @decl array(Pike.BacktraceFrame) backtrace() *! *! FIXME: This documentation is not up to date! *! *! Get a description of the current call stack. *! *! The description is returned as an array with one entry for each call *! frame on the stack. *! *! Each entry has this format: *! @array *! @elem string file *! A string with the filename if known, else zero. *! @elem int line *! An integer containing the linenumber if known, else zero. *! @elem function fun *! The function that was called at this level. *! @elem mixed|void ... args *! The arguments that the function was called with. *! @endarray *! *! The current call frame will be last in the array. *! *! @note *! Please note that the frame order may be reversed in a later version
c717042003-03-12Marcus Agehall  *! (than 7.1) of Pike to accommodate for deferred backtraces.
a8e9892001-09-05Fredrik Hübinette (Hubbe)  *! *! Note that the arguments reported in the backtrace are the current *! values of the variables, and not the ones that were at call-time. *! This can be used to hide sensitive information from backtraces *! (eg passwords). *! *! @seealso *! @[catch()], @[throw()] */ PMOD_EXPORT PIKEFUN array(mixed) backtrace() efun; optflags OPT_EXTERNAL_DEPEND; { low_backtrace(& Pike_interpreter); }
a3c4332001-06-20Per Hedbor #define INITIAL_BUF_LEN 4096 /*! @module String */ /*! @class Buffer *! A buffer, used for building strings. It's *! conceptually similar to a string, but you can only @[add] *! strings to it, and you can only @[get] the value from it once. *! *! There is a reason for those seemingly rather odd limitations, *! it makes it possible to do some optimizations that really speed *! things up. *! *! You do not need to use this class unless you add very many *! strings together, or very large strings. *! *! @example *! For the fastest possible operation, write your code like this: *!
f79bd82003-04-01Martin Nilsson  *! @code *! String.Buffer b = String.Buffer( );
a3c4332001-06-20Per Hedbor  *!
f79bd82003-04-01Martin Nilsson  *! function add = b->add;
a3c4332001-06-20Per Hedbor  *!
f79bd82003-04-01Martin Nilsson  *! .. call add several times in code ...
a3c4332001-06-20Per Hedbor  *!
f79bd82003-04-01Martin Nilsson  *! string result = b->get(); // also clears the buffer *! @endcode
a3c4332001-06-20Per Hedbor  */
41730d2001-07-26Martin Nilsson PIKECLASS Buffer
a3c4332001-06-20Per Hedbor {
73b07a2001-06-21Per Hedbor  CVAR struct string_builder str; CVAR int initial;
a3c4332001-06-20Per Hedbor  void f_Buffer_get_copy( INT32 args ); void f_Buffer_get( INT32 args ); void f_Buffer_add( INT32 args );
a465852002-01-01Martin Nilsson  /*! @decl void create(int initial_size)
41730d2001-07-26Martin Nilsson  *! *! Initializes a new buffer. *!
1f88bf2001-09-24Henrik Grubbström (Grubba)  *! If no @[initial_size] is specified, 256 is used. If you
41730d2001-07-26Martin Nilsson  *! know approximately how big the buffer will be, you can optimize *! the operation of @[add()] (slightly) by passing the size to this *! function. */
a3c4332001-06-20Per Hedbor  PIKEFUN void create( int|void size ) { struct Buffer_struct *str = THIS; if( args ) str->initial = MAXIMUM( size->u.integer, 512 ); else {
73b07a2001-06-21Per Hedbor  str->initial = 256;
a3c4332001-06-20Per Hedbor  push_int(0); } }
18c2252003-04-10Martin Nilsson  /*! @decl string _sprintf( int flag, mapping flags ) *! It is possible to @[sprintf] a String.Buffer object *! as @tt{%s@} just as if it was a string. */
a3c4332001-06-20Per Hedbor  PIKEFUN string _sprintf( int flag, mapping flags ) { switch( flag ) { case 'O': { struct pike_string *res; struct Buffer_struct *str = THIS; push_text( "Buffer(%d /* %d */)" );
73b07a2001-06-21Per Hedbor  if( str->str.s )
a3c4332001-06-20Per Hedbor  {
73b07a2001-06-21Per Hedbor  push_int(str->str.s->len); push_int(str->str.malloced);
a3c4332001-06-20Per Hedbor  } else { push_int( 0 ); push_int( 0 ); } f_sprintf( 3 );
cdf18a2003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
a3c4332001-06-20Per Hedbor  res = Pike_sp[-1].u.string; Pike_sp--; RETURN res; } case 's': { pop_n_elems( args ); if( Pike_fp->current_object->refs != 1 ) f_Buffer_get_copy( 0 ); else f_Buffer_get( 0 ); } return; case 't': RETURN make_shared_binary_string("Buffer",6); } pop_n_elems( args ); push_int( 0 ); Pike_sp[-1].subtype = 1; }
18c2252003-04-10Martin Nilsson  /*! @decl mixed cast( string type ) *! It is possible to cast a String.Buffer object to *! a @expr{string@} and an @expr{int@}. */
a3c4332001-06-20Per Hedbor  PIKEFUN mixed cast( string type ) { struct pike_string *string_t; struct pike_string *int_t;
de56ec2003-02-08Martin Stjernholm  MAKE_CONST_STRING( string_t, "string" ); MAKE_CONST_STRING( int_t, "int" );
a3c4332001-06-20Per Hedbor  if( type == string_t ) { pop_n_elems( args ); if( Pike_fp->current_object->refs != 1 ) f_Buffer_get_copy( 0 ); else f_Buffer_get( 0 ); return; } if( type == int_t ) { struct Buffer_struct *str = THIS; pop_stack(); if( Pike_fp->current_object->refs != 1 ) f_Buffer_get_copy( 0 ); else f_Buffer_get( 0 ); o_cast_to_int( ); return; } Pike_error("Cannot cast to %s\n", type->str ); }
18c2252003-04-10Martin Nilsson  /*! @decl String.Buffer `+( string what ) */
a3c4332001-06-20Per Hedbor  PIKEFUN object `+( string what ) { struct Buffer_struct *str = THIS, *str2;
7906e02003-04-07Martin Stjernholm  struct object *res = fast_clone_object( Buffer_program ); str2 = OBJ2_BUFFER( res ); str2->initial = str->initial;
73b07a2001-06-21Per Hedbor  if( str->str.s )
7906e02003-04-07Martin Stjernholm  init_string_builder_copy (&str2->str, &str->str);
a3c4332001-06-20Per Hedbor  apply( res, "add", 1 ); RETURN res; }
173e872003-04-07Martin Stjernholm 
18c2252003-04-10Martin Nilsson  /*! @decl String.Buffer `+=( string what ) */
173e872003-04-07Martin Stjernholm  PIKEFUN object `+=( string what ) { f_Buffer_add( 1 ); REF_RETURN Pike_fp->current_object; }
a3c4332001-06-20Per Hedbor 
4e5f5d2001-10-04Martin Nilsson  /*! @decl int add(string ... data)
41730d2001-07-26Martin Nilsson  *! *! Adds @[data] to the buffer. Returns the size of the buffer. *! */
3301b12001-06-20Per Hedbor  PIKEFUN int add( string ... arg1 )
a3c4332001-06-20Per Hedbor  { struct Buffer_struct *str = THIS;
3301b12001-06-20Per Hedbor  int j;
b195b92001-09-21Henrik Grubbström (Grubba)  if (!str->str.s && args) { int sum = 0; int shift = 0; for (j=0; j < args; j++) { struct pike_string *a = Pike_sp[j-args].u.string; sum += a->len; shift |= a->size_shift; } if (sum < str->initial) { sum = str->initial; }
73b08f2003-01-31Martin Stjernholm  shift = shift & ~(shift >> 1); init_string_builder_alloc(&str->str, sum, shift); /* We know it will be a string that really is this wide. */ str->str.known_shift = shift;
b195b92001-09-21Henrik Grubbström (Grubba)  }
a3c4332001-06-20Per Hedbor 
3301b12001-06-20Per Hedbor  for( j = 0; j<args; j++ )
a3c4332001-06-20Per Hedbor  {
b195b92001-09-21Henrik Grubbström (Grubba)  struct pike_string *a = Pike_sp[j-args].u.string;
73b07a2001-06-21Per Hedbor  string_builder_shared_strcat( &str->str, a );
3301b12001-06-20Per Hedbor  }
b195b92001-09-21Henrik Grubbström (Grubba)  if (str->str.s) { RETURN str->str.s->len; } else { RETURN 0; }
a3c4332001-06-20Per Hedbor  }
41730d2001-07-26Martin Nilsson  /*! @decl string get_copy() *! *! Get the data from the buffer. Significantly slower than @[get], *! but does not clear the buffer. */
a3c4332001-06-20Per Hedbor  PIKEFUN string get_copy() {
73b07a2001-06-21Per Hedbor  struct pike_string *str = THIS->str.s; if( str )
a3c4332001-06-20Per Hedbor  {
73b07a2001-06-21Per Hedbor  ptrdiff_t len = str->len; if( len > 0 ) { char *d = (char *)str->str; switch( str->size_shift ) { case 0:
d807d52002-10-15Henrik Grubbström (Grubba)  RETURN make_shared_binary_string0((p_wchar0 *)d,len);
73b07a2001-06-21Per Hedbor  break; case 1:
d807d52002-10-15Henrik Grubbström (Grubba)  RETURN make_shared_binary_string1((p_wchar1 *)d,len>>1);
73b07a2001-06-21Per Hedbor  break; case 2:
d807d52002-10-15Henrik Grubbström (Grubba)  RETURN make_shared_binary_string2((p_wchar2 *)d,len>>2);
73b07a2001-06-21Per Hedbor  break; } }
a3c4332001-06-20Per Hedbor  }
73b07a2001-06-21Per Hedbor  push_text(""); return;
a3c4332001-06-20Per Hedbor  }
41730d2001-07-26Martin Nilsson  /*! @decl string get() *! *! Get the data from the buffer. *! *! @note *! This will clear the data in the buffer */
a3c4332001-06-20Per Hedbor  PIKEFUN string get( ) { struct Buffer_struct *str = THIS;
73b07a2001-06-21Per Hedbor  if( str->str.s )
a3c4332001-06-20Per Hedbor  {
73b07a2001-06-21Per Hedbor  struct pike_string *s = finish_string_builder( &str->str ); str->str.malloced = 0; str->str.s = 0; RETURN s;
a3c4332001-06-20Per Hedbor  }
73b07a2001-06-21Per Hedbor  pop_n_elems(args); push_text(""); return;
a3c4332001-06-20Per Hedbor  }
edb0842001-07-11Martin Stjernholm  /*! @decl int _sizeof() *! *! Returns the size of the buffer. */
41730d2001-07-26Martin Nilsson  PIKEFUN int _sizeof()
edb0842001-07-11Martin Stjernholm  { struct Buffer_struct *str = THIS; RETURN str->str.s ? str->str.s->len : 0; }
a3c4332001-06-20Per Hedbor  INIT { struct Buffer_struct *str = THIS;
73b07a2001-06-21Per Hedbor  MEMSET( str, 0, sizeof( *str ) );
a3c4332001-06-20Per Hedbor  } EXIT { struct Buffer_struct *str = THIS;
73b07a2001-06-21Per Hedbor  if( str->str.s ) free_string_builder( &str->str );
a3c4332001-06-20Per Hedbor  } }
41730d2001-07-26Martin Nilsson /*! @endclass
fed7de2001-06-28Henrik Grubbström (Grubba)  */ /*! @class Replace */ PIKECLASS multi_string_replace { CVAR struct tupel { int prefix; struct pike_string *ind; struct pike_string *val; } *v; CVAR size_t v_sz; CVAR size_t sz; CVAR INT32 set_start[256]; CVAR INT32 set_end[256]; static int replace_sortfun(struct tupel *a,struct tupel *b) { return DO_NOT_WARN((int)my_quick_strcmp(a->ind, b->ind)); }
18c2252003-04-10Martin Nilsson  /*! @decl void create(array(string)|void from, array(string)|void to) */
f01b122001-07-01Henrik Grubbström (Grubba)  PIKEFUN void create(array(string)|void from_, array(string)|void to_)
fed7de2001-06-28Henrik Grubbström (Grubba)  { int i;
f01b122001-07-01Henrik Grubbström (Grubba)  struct array *from; struct array *to; if (!args) { push_int(0); return; } if (!from_ || !to_) { Pike_error("Bad number of arguments to create().\n"); } from = from_->u.array; to = to_->u.array;
fed7de2001-06-28Henrik Grubbström (Grubba)  if (from->size != to->size) { Pike_error("Replace must have equal-sized from and to arrays.\n"); } for (i = 0; i < (int)from->size; i++) { if (from->item[i].type != PIKE_T_STRING) { Pike_error("Replace: from array is not an array(string).\n"); } if (to->item[i].type != PIKE_T_STRING) { Pike_error("Replace: to array is not an array(string).\n"); } } if (THIS->v) { for (i = 0; i < (int)THIS->v_sz; i++) { if (!THIS->v[i].ind) break; free_string(THIS->v[i].ind); THIS->v[i].ind = NULL; free_string(THIS->v[i].val); THIS->v[i].val = NULL; } } if (THIS->v && (THIS->v_sz < (size_t)from->size)) { free(THIS->v); THIS->v = NULL; THIS->v_sz = 0; } if (!THIS->v) { THIS->v = (struct tupel *)xalloc(sizeof(struct tupel) * from->size); THIS->v_sz = from->size; } for (i = 0; i < (int)from->size; i++) { copy_shared_string(THIS->v[i].ind, from->item[i].u.string); copy_shared_string(THIS->v[i].val, to->item[i].u.string); THIS->v[i].prefix = -2; /* Uninitialized */ } THIS->sz = from->size; fsort((char *)THIS->v, from->size, sizeof(struct tupel), (fsortfun)replace_sortfun); MEMSET(THIS->set_start, 0, sizeof(INT32)*256); MEMSET(THIS->set_end, 0, sizeof(INT32)*256); for (i = 0; i < (int)from->size; i++) { INT32 x = index_shared_string(THIS->v[from->size-1-i].ind, 0); if ((x >= 0) && (x < 256)) THIS->set_start[x] = from->size-1-i; x = index_shared_string(THIS->v[i].ind, 0); if ((x >= 0) && (x < 256)) THIS->set_end[x] = i+1; }
f01b122001-07-01Henrik Grubbström (Grubba)  pop_n_elems(args); push_int(0);
fed7de2001-06-28Henrik Grubbström (Grubba)  } static int find_longest_prefix(char *str, ptrdiff_t len, int size_shift, struct tupel *v, INT32 a, INT32 b) { INT32 c,match=-1; ptrdiff_t tmp; while(a<b) { c=(a+b)/2; tmp=generic_quick_binary_strcmp(v[c].ind->str, v[c].ind->len, v[c].ind->size_shift, str, MINIMUM(len,v[c].ind->len), size_shift); if(tmp<0) { INT32 match2=find_longest_prefix(str, len, size_shift, v, c+1, b); if(match2!=-1) return match2; while(1) { if(v[c].prefix==-2) { v[c].prefix=find_longest_prefix(v[c].ind->str, v[c].ind->len, v[c].ind->size_shift, v, 0 /* can this be optimized? */, c); } c=v[c].prefix; if(c<a || c<match) return match; if(!generic_quick_binary_strcmp(v[c].ind->str, v[c].ind->len, v[c].ind->size_shift, str, MINIMUM(len,v[c].ind->len), size_shift)) return c; } } else if(tmp>0) { b=c; } else { a=c+1; /* There might still be a better match... */ match=c; } } return match; }
18c2252003-04-10Martin Nilsson  /*! @decl string `()(string str) */
fed7de2001-06-28Henrik Grubbström (Grubba)  PIKEFUN string `()(string str) { struct string_builder ret; ptrdiff_t length = str->len; ptrdiff_t s; int *set_start = THIS->set_start; int *set_end = THIS->set_end; struct tupel *v = THIS->v; int num = THIS->sz; if (!num) { add_ref(str); RETURN str; } init_string_builder(&ret,str->size_shift); for(s=0;length > 0;) { INT32 a,b; ptrdiff_t ch; ch = index_shared_string(str, s); if((ch >= 0) && (ch < 256)) b = set_end[ch]; else b = num; if(b) { if((ch >= 0) && (ch < 256)) a = set_start[ch]; else a = 0; a = find_longest_prefix(str->str+(s << str->size_shift), length, str->size_shift, v, a, b); if(a!=-1) { ch = v[a].ind->len; if(!ch) ch=1; s += ch; length -= ch; string_builder_shared_strcat(&ret, v[a].val); continue; } } string_builder_putchar(&ret, DO_NOT_WARN((INT32)ch)); s++; length--; } RETURN finish_string_builder(&ret); }
18c2252003-04-10Martin Nilsson  /*! @decl array(string) _encode() */
9f91572001-07-01Henrik Grubbström (Grubba)  PIKEFUN array(string) _encode() { size_t i; for (i=0; i < THIS->sz; i++) { ref_push_string(THIS->v[i].ind); } f_aggregate(DO_NOT_WARN((INT32)THIS->sz)); for (i=0; i < THIS->sz; i++) { ref_push_string(THIS->v[i].val); } f_aggregate(DO_NOT_WARN((INT32)THIS->sz)); f_aggregate(2); }
18c2252003-04-10Martin Nilsson  /*! @decl void _decode(array(array(string)) encoded) */
9f91572001-07-01Henrik Grubbström (Grubba)  PIKEFUN void _decode(array(array(string)) encoded) { INT32 i; for (i=0; i < encoded->size; i++) { push_svalue(encoded->item + i); stack_swap(); } pop_stack(); f_multi_string_replace_create(i); }
fed7de2001-06-28Henrik Grubbström (Grubba)  INIT { THIS->v = NULL; THIS->v_sz = 0; THIS->sz = 0; } EXIT { if (THIS->v) { int i; for (i = 0; i < (int)THIS->v_sz; i++) { if (!THIS->v[i].ind) break; free_string(THIS->v[i].ind); THIS->v[i].ind = NULL; free_string(THIS->v[i].val); THIS->v[i].val = NULL; } free(THIS->v); } THIS->v = NULL; THIS->v_sz = 0; THIS->sz = 0; } }
0c4ad02001-07-05Henrik Grubbström (Grubba) /*! @endclass */ /*! @class SingleReplace */ PIKECLASS single_string_replace { CVAR SearchMojt mojt; CVAR struct pike_string *del; CVAR struct pike_string *to; INIT { THIS->mojt.vtab = NULL; THIS->mojt.data = NULL; THIS->del = NULL; THIS->to = NULL; } EXIT { if (THIS->mojt.vtab) { THIS->mojt.vtab->freeme(THIS->mojt.data); THIS->mojt.vtab = NULL; THIS->mojt.data = NULL; } if (THIS->del) { free_string(THIS->del); THIS->del = NULL; } if (THIS->to) { free_string(THIS->to); THIS->to = NULL; } }
18c2252003-04-10Martin Nilsson  /*! @decl void create(string|void del, string|void to) */
0c4ad02001-07-05Henrik Grubbström (Grubba)  PIKEFUN void create(string|void del_, string|void to_) { struct pike_string *del; struct pike_string *to; /* Clean up... */ exit_single_string_replace_struct(); if (!del_) return; if (!to_) { SIMPLE_BAD_ARG_ERROR("String.SingleReplace->create", 2, "string"); } if (del_->u.string == to_->u.string) { /* No-op... */ return; } copy_shared_string(THIS->del, del = del_->u.string); copy_shared_string(THIS->to, to = to_->u.string); if (del->len) {
50edc82001-07-13Henrik Grubbström (Grubba)  THIS->mojt = simple_compile_memsearcher(del);
0c4ad02001-07-05Henrik Grubbström (Grubba)  } } /*** replace function ***/ typedef char *(* replace_searchfunc)(void *,void *,size_t);
18c2252003-04-10Martin Nilsson  /*! @decl string `()(string str) */
0c4ad02001-07-05Henrik Grubbström (Grubba)  PIKEFUN string `()(string str) { int shift; struct pike_string *del = THIS->del; struct pike_string *to = THIS->to; struct pike_string *ret = NULL; if (!str->len || !del || !to) { /* The result is already on the stack in the correct place... */ return; } shift = MAXIMUM(str->size_shift, to->size_shift); if (!del->len) { int e, pos; ret = begin_wide_shared_string(str->len + to->len * (str->len-1), shift); low_set_index(ret, 0, index_shared_string(str, 0)); for(pos=e=1;e<str->len;e++) { pike_string_cpy(MKPCHARP_STR_OFF(ret,pos), to); pos+=to->len; low_set_index(ret,pos++,index_shared_string(str,e)); } } else { char *s, *end, *tmp; replace_searchfunc f = (replace_searchfunc)0; void *mojt_data = THIS->mojt.data; PCHARP r; end = str->str+(str->len<<str->size_shift); switch(str->size_shift) { case 0: f = (replace_searchfunc)THIS->mojt.vtab->func0; break; case 1: f = (replace_searchfunc)THIS->mojt.vtab->func1; break; case 2: f = (replace_searchfunc)THIS->mojt.vtab->func2; break; #ifdef PIKE_DEBUG
5aad932002-08-15Marcus Comstedt  default: Pike_fatal("Illegal shift.\n");
0c4ad02001-07-05Henrik Grubbström (Grubba) #endif } if(del->len == to->len) { ret = begin_wide_shared_string(str->len, shift); } else { INT32 delimiters = 0; s = str->str; while((s = f(mojt_data, s, (end-s)>>str->size_shift))) { delimiters++; s += del->len << str->size_shift; } if (!delimiters) { /* The result is already on the stack in the correct place... */ return; } ret = begin_wide_shared_string(str->len + (to->len-del->len)*delimiters, shift); } s = str->str; r = MKPCHARP_STR(ret); while((tmp = f(mojt_data, s, (end-s)>>str->size_shift))) { #ifdef PIKE_DEBUG if(tmp + (del->len << str->size_shift) > end)
5aad932002-08-15Marcus Comstedt  Pike_fatal("generic_memory_search found a match beyond end of string!\n");
0c4ad02001-07-05Henrik Grubbström (Grubba) #endif generic_memcpy(r,MKPCHARP(s,str->size_shift),(tmp-s)>>str->size_shift); INC_PCHARP(r,(tmp-s)>>str->size_shift); pike_string_cpy(r,to); INC_PCHARP(r,to->len); s=tmp+(del->len << str->size_shift); } generic_memcpy(r,MKPCHARP(s,str->size_shift),(end-s)>>str->size_shift); } RETURN end_shared_string(ret); }
18c2252003-04-10Martin Nilsson  /*! @decl array(string) _encode() */
0c4ad02001-07-05Henrik Grubbström (Grubba)  PIKEFUN array(string) _encode() { if (THIS->del) { ref_push_string(THIS->del); ref_push_string(THIS->to); f_aggregate(2); } else { push_int(0); } }
18c2252003-04-10Martin Nilsson  /*! @decl void _decode(array(string)|int(0..0) encoded) */
0c4ad02001-07-05Henrik Grubbström (Grubba)  PIKEFUN void _decode(array(string)|int(0..0) encoded_) { INT32 i = 0; if (encoded_->type == PIKE_T_ARRAY) { struct array *encoded = encoded_->u.array; for (i=0; i < encoded->size; i++) { push_svalue(encoded->item + i); stack_swap(); } } pop_stack(); f_single_string_replace_create(i); } }
19f7672003-02-18Marcus Comstedt /*! @endclass */ /*! @class Bootstring
3715ee2003-02-19Marcus Comstedt  *! *! This class implements the "Bootstring" string transcoder described in *! @url{http://www.ietf.org/internet-drafts/draft-ietf-idn-punycode-03.txt@}.
19f7672003-02-18Marcus Comstedt  */ PIKECLASS bootstring { CVAR INT_TYPE base, tmin, tmax, skew, damp; CVAR INT_TYPE initial_bias, initial_n; CVAR p_wchar2 delim;
0b775e2003-02-19Marcus Comstedt  PIKEVAR string digits flags ID_STATIC|ID_PRIVATE;
19f7672003-02-18Marcus Comstedt  static INT_TYPE bootstring_cp_to_digit(p_wchar2 ch) { ptrdiff_t digit = THIS->digits->len; PCHARP digits = MKPCHARP_STR( THIS->digits ); while (digit>=0) if (INDEX_PCHARP( digits, digit ) == ch) return digit; else --digit; return -1; } static INT_TYPE bootstring_adapt(INT_TYPE delta, INT_TYPE numpoints, int firsttime) { struct bootstring_struct *bs = THIS; INT_TYPE k = 0, b = bs->base; INT_TYPE a = b - bs->tmin; INT_TYPE limit = (a * bs->tmax) >> 1; if (firsttime) delta /= bs->damp; else delta >>= 1; delta += delta / numpoints; while (delta > limit) { delta /= a; k += b; } return k + (a + 1)*delta / (delta + bs->skew); }
3715ee2003-02-19Marcus Comstedt  /*! @decl string decode(string s) *! *! Decodes a Bootstring encoded string of "basic" code points back *! to the original string space. */
19f7672003-02-18Marcus Comstedt  PIKEFUN string decode(string s) { struct bootstring_struct *bs = THIS; INT_TYPE n = bs->initial_n; INT_TYPE i = 0; INT_TYPE bias = bs->initial_bias; ptrdiff_t pos, input_left; PCHARP input; struct string_builder output; init_string_builder( &output,0 ); input = MKPCHARP_STR( s ); input_left = s->len; for (pos = input_left-1; pos > 0; --pos) if (INDEX_PCHARP( input, pos ) == bs->delim) { string_builder_append( &output, input, pos ); INC_PCHARP( input, pos+1 ); input_left -= pos+1; break; } while (input_left > 0) { INT_TYPE oldi = i; INT_TYPE w = 1; INT_TYPE k; for (k=bs->base; ; k+=bs->base) { INT_TYPE digit, t; if (input_left < 1 || (digit = bootstring_cp_to_digit( EXTRACT_PCHARP( input ) )) < 0) { free_string_builder( &output ); Pike_error( "Invalid variable-length integer.\n" ); } INC_PCHARP( input, 1 ); --input_left; i += digit * w; /* fail on overflow... */ if (k <= bias + bs->tmin) t = bs->tmin; else if (k >= bias + bs->tmax) t = bs->tmax; else t = k - bias; if (digit < t) break; w *= (bs->base - t); } bias = bootstring_adapt( i - oldi, output.s->len+1, !oldi ); n += i / (output.s->len+1); i %= output.s->len+1; string_builder_putchar( &output, n ); if (i != output.s->len-1) switch (output.s->size_shift) { case 0: { p_wchar0 *s = STR0(output.s); INT_TYPE p = output.s->len; while (--p>i) s[p] = s[p-1]; s[p] = n; } break; case 1: { p_wchar1 *s = STR1(output.s); INT_TYPE p = output.s->len; while (--p>i) s[p] = s[p-1]; s[p] = n; } break; case 2: { p_wchar2 *s = STR2(output.s); INT_TYPE p = output.s->len; while (--p>i) s[p] = s[p-1]; s[p] = n; } break; default: Pike_fatal("Illegal shift size!\n"); } i++; } RETURN finish_string_builder( &output ); }
3715ee2003-02-19Marcus Comstedt  /*! @decl string encode(string s) *! *! Encodes a string using Bootstring encoding into a string constisting *! only of "basic" code points (< initial_n). */
19f7672003-02-18Marcus Comstedt  PIKEFUN string encode(string s) { struct bootstring_struct *bs = THIS; INT_TYPE n = bs->initial_n; INT_TYPE delta = 0; INT_TYPE bias = bs->initial_bias; INT_TYPE c, h, b = 0; ptrdiff_t pos, input_left; PCHARP input; struct string_builder output; init_string_builder( &output,0 ); input = MKPCHARP_STR( s ); input_left = s->len; for (pos=0; pos<input_left; pos++) if ((c = INDEX_PCHARP( input, pos )) < n) { string_builder_putchar( &output, c ); b++; } if ((h = b)) string_builder_putchar( &output, bs->delim ); while (h < input_left) { INT_TYPE m = -1; for (pos=0; pos<input_left; pos++) if ((c = INDEX_PCHARP( input, pos )) >= n && (m < 0 || c < m)) m = c; delta = delta + (m - n) * (h + 1); /* fail on overflow... */ n = m; for (pos=0; pos<input_left; pos++) if ((c = INDEX_PCHARP( input, pos )) < n) delta++; else if (c == n) { INT_TYPE k, q = delta; for (k=bs->base; ; k+=bs->base) { INT_TYPE t, bt; if (k <= bias + bs->tmin) t = bs->tmin; else if(k >= bias + bs->tmax) t = bs->tmax; else t = k-bias; if (q < t) break; bt = bs->base - t; string_builder_putchar( &output, index_shared_string( bs->digits, t + (q-t)%bt ) ); q = (q-t) / bt; } string_builder_putchar( &output, index_shared_string( bs->digits, q ) ); bias = bootstring_adapt( delta, h+1, h==b ); delta = 0; h++; } delta++; n++; } RETURN finish_string_builder( &output ); }
3715ee2003-02-19Marcus Comstedt  /*! @decl void create(int base, int tmin, int tmax, int skew, @ *! int damp, int initial_bias, int initial_n, @ *! int delim, string digits) *! *! Creates a Bootstring transcoder instance using the specified parameters. *! *! @param base *! The base used by the variable-length integers. *! @param tmin *! The minimum threshold digit value for the variable-length integers. *! Must be >=0 and <= tmax. *! @param tmax *! The maximum threshold digit value for the variable-length integers. *! Must be <= base-1. *! @param skew *! The skew term for the bias adapation. Must be >= 1. *! @param damp
1ae3d62003-02-19Henrik Grubbström (Grubba)  *! The damping factor for the bias adaption. Must be >= 2.
3715ee2003-02-19Marcus Comstedt  *! @param initial_bias *! The initial bias for the variable-length integer thresholding. *! initial_bias % base must be <= base - tmin. *! @param initial_n *! The first code point outside the "basic" set of code points. *! @param delim *! The "basic" code point used as the delimiter. *! @param digits *! The "basic" code points used as digits. The length of the string *! should be the same as the base parameter. */
19f7672003-02-18Marcus Comstedt  PIKEFUN void create( int base, int tmin, int tmax, int skew, int damp, int initial_bias, int initial_n, int delim, string digits )
3715ee2003-02-19Marcus Comstedt  flags ID_STATIC;
19f7672003-02-18Marcus Comstedt  { struct bootstring_struct *bs = THIS;
3715ee2003-02-19Marcus Comstedt  if (base<2) Pike_error("Bogus base\n"); if (tmin<0 || tmax<tmin || base-1<tmax) Pike_error("Parameters violate 0 <= tmin <= tmax <= base-1\n"); if (skew < 1) Pike_error("Parameters violate skew >= 1\n"); if (damp < 2) Pike_error("Parameters violate damp >= 2\n"); if (initial_bias%base > base-tmin) Pike_error("Parameters violate initial_bias%%base <= base-tmin\n"); if (digits->len != base) Pike_error("Length of digits string does not match base.\n");
19f7672003-02-18Marcus Comstedt  bs->base = base; bs->tmin = tmin; bs->tmax = tmax; bs->skew = skew; bs->damp = damp; bs->initial_bias = initial_bias; bs->initial_n = initial_n; bs->delim = delim; if (bs->digits) { free_string( bs->digits ); bs->digits = NULL; } copy_shared_string( bs->digits, digits ); } }
da90692002-11-26Henrik Grubbström (Grubba) /*! @endclass */ /*! @endmodule */ /*! @module System */ /*! @class Time *! *! The current time as a structure containing a sec and a usec *! member. */ PIKECLASS Time { CVAR int hard_update; /*! @decl int sec; *! @decl int usec; *! *! The number of seconds and microseconds since the epoch and the *! last whole second, respectively. (See also @[predef::time()]) *! *! Please note that these variables will continually update when *! they are requested, there is no need to create new Time() *! objects. */ /*! @decl int usec_full; *! *! The number of microseconds since the epoch. Please note that *! pike has to have been compiled with bignum support for this *! variable to contain sensible values. */ PIKEFUN int `->( string x ) { extern struct timeval current_time; struct pike_string *usec; struct pike_string *sec;
51adb82003-01-12Martin Stjernholm 
de56ec2003-02-08Martin Stjernholm  MAKE_CONST_STRING( sec, "sec" ); MAKE_CONST_STRING( usec, "usec" );
da90692002-11-26Henrik Grubbström (Grubba)  if( !x ) RETURN 0; if( THIS->hard_update ) GETTIMEOFDAY( &current_time ); if( x == usec ) RETURN current_time.tv_usec; if( x == sec ) RETURN current_time.tv_sec; #ifdef AUTO_BIGNUM pop_stack(); push_int( current_time.tv_sec ); push_int( 1000000 ); f_multiply( 2 ); push_int( current_time.tv_usec ); f_add( 2 ); return; #else RETURN (current_time.tv_sec * 1000000 + current_time.tv_usec); #endif } PIKEFUN int `[]( string x ) { f_Time_cq__backtick_2D_3E( args ); } /*! @decl static void create( int fast ); *! *! If fast is true, do not request a new time from the system, *! instead use the global current time variable. *! *! This will only work in callbacks, but can save significant amounts *! of CPU. */ PIKEFUN void create( int|void fast ) { THIS->hard_update = !fast; } } /*! @endclass */ /*! @class Timer */ PIKECLASS Timer { CVAR struct timeval last_time; CVAR int hard_update; /*! @decl float peek() *! Return the time in seconds since the last time @[get] was called. */ PIKEFUN float peek( ) { extern struct timeval current_time; FLOAT_TYPE res; if( THIS->hard_update ) GETTIMEOFDAY( &current_time ); res = current_time.tv_sec-THIS->last_time.tv_sec + (current_time.tv_usec-THIS->last_time.tv_usec)/1000000.0; RETURN res; } /*! @decl float get() *! Return the time in seconds since the last time get was called. *! The first time this method is called the time since the object *! was created is returned instead. */ PIKEFUN float get( ) { extern struct timeval current_time; f_Timer_peek( 0 ); THIS->last_time = current_time; return; } /*! @decl static void create( int|void fast ) *! Create a new timer object. The timer keeps track of relative time *! with sub-second precision. *! *! If fast is specified, the timer will not do system calls to get *! the current time but instead use the one maintained by pike. This *! will result in faster but somewhat more inexact timekeeping. *! Also, if your program never utilizes the pike event loop the pike *! maintained current time never change. */ PIKEFUN void create( int|void fast ) { extern struct timeval current_time; THIS->hard_update = !fast; if( THIS->hard_update ) GETTIMEOFDAY( &current_time ); THIS->last_time = current_time; } }
fed7de2001-06-28Henrik Grubbström (Grubba) /*! @endclass */ /*! @endmodule */
a3c4332001-06-20Per Hedbor 
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  PIKECLASS automap_marker { PIKEVAR array arg; PIKEVAR int depth; PIKEFUN void create(array a, int d) { if(THIS->arg) free_array(THIS->arg); add_ref(THIS->arg=a); THIS->depth=d; } PIKEFUN string _sprintf(int mode, mapping flags) { pop_n_elems(args);
e6dbc22002-11-29Marcus Comstedt  if (mode != 'O') { push_undefined (); return; }
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  push_text("%O%*'[*]'n"); if(THIS->arg) ref_push_array(THIS->arg); else push_int(0); push_int(THIS->depth*3); f_sprintf(3); } } static void low_automap(int d, int depth, struct svalue *fun, struct svalue *real_args, INT32 args) { INT32 x,e,tmp,size=0x7fffffff; struct svalue *tmpargs=Pike_sp - args; struct array *ret;
2523ce2003-04-28Martin Stjernholm  TYPE_FIELD types;
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  for(e=0;e<args;e++) { if(real_args[e].type==T_OBJECT && real_args[e].u.object->prog == automap_marker_program && OBJ2_AUTOMAP_MARKER(real_args[e].u.object)->depth >= d) { if(tmpargs[e].type != T_ARRAY)
a241e02001-09-27Fredrik Hübinette (Hubbe)  index_error("__automap__", Pike_sp-args, args, tmpargs, NULL, "Automap on non-array.\n");
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  tmp=tmpargs[e].u.array->size; if(tmp < size) size=tmp; } } #ifdef PIKE_DEBUG if(size == 0x7fffffff)
5aad932002-08-15Marcus Comstedt  Pike_fatal("No automap markers found in low_automap\n");
8bef1b2001-09-27Fredrik Hübinette (Hubbe) #endif push_array(ret=allocate_array(size));
2523ce2003-04-28Martin Stjernholm  types = 0;
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  for(x=0;x<size;x++) { for(e=0;e<args;e++) { if(real_args[e].type==T_OBJECT && real_args[e].u.object->prog == automap_marker_program && OBJ2_AUTOMAP_MARKER(real_args[e].u.object)->depth >= d) { #ifdef PIKE_DEBUG if(x >= tmpargs[e].u.array->size)
5aad932002-08-15Marcus Comstedt  Pike_fatal("low_automap failed to determine size!\n");
8bef1b2001-09-27Fredrik Hübinette (Hubbe) #endif push_svalue(ITEM(tmpargs[e].u.array)+x); }else{ push_svalue(tmpargs+e); } } if(d == depth) apply_svalue(fun,args); else low_automap(d+1,depth,fun,real_args,args);
2523ce2003-04-28Martin Stjernholm  stack_pop_to_no_free (ITEM(ret) + x); types |= 1 << ITEM(ret)[x].type;
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  }
2523ce2003-04-28Martin Stjernholm  ret->type_field = types;
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  stack_unlink(args); } PIKEFUN array __automap__(mixed fun, mixed ... tmpargs) efun; { int e,depth=-1; check_stack(args); for(e=0;e<args-1;e++) { if(tmpargs[e].type==T_OBJECT && tmpargs[e].u.object->prog == automap_marker_program) { int tmp=OBJ2_AUTOMAP_MARKER(tmpargs[e].u.object)->depth; if(tmp > depth) depth=tmp; ref_push_array(OBJ2_AUTOMAP_MARKER(tmpargs[e].u.object)->arg); }else{ push_svalue(tmpargs+e); } } check_stack(depth * (args+1)); low_automap(1,depth,fun,tmpargs,args-1); stack_unlink(args); }
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) void init_builtin(void) {
ab82822000-05-25Fredrik Hübinette (Hubbe) INIT
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) }
8650752001-06-25Henrik Grubbström (Grubba)  void exit_builtin(void) { EXIT }