9da7f42001-06-05Martin Stjernholm /* -*- c -*- * $Id: builtin.cmod,v 1.30 2001/06/05 00:03:57 mast Exp $ */
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"
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) 
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: *! @code{map(@[data], lambda(mixed x,mixed y) { return x[y]; }, @[index])@} *! *! 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; { INT32 e; struct array *a; DECLARE_CYCLIC(); /* Optimization */
b0f8352001-01-07Henrik Grubbström (Grubba)  if(data->refs == 1)
3a5b1d2000-05-24Fredrik Hübinette (Hubbe)  { /* An array with one ref cannot possibly be cyclic */ struct svalue sval;
b0f8352001-01-07Henrik Grubbström (Grubba)  data->type_field = BIT_MIXED | BIT_UNFINISHED; for(e=0;e<data->size;e++)
3a5b1d2000-05-24Fredrik Hübinette (Hubbe)  {
b0f8352001-01-07Henrik Grubbström (Grubba)  index_no_free(&sval, ITEM(data)+e, index); free_svalue(ITEM(data)+e); ITEM(data)[e]=sval;
3a5b1d2000-05-24Fredrik Hübinette (Hubbe)  } pop_stack(); return; }
b0f8352001-01-07Henrik Grubbström (Grubba)  if((a=(struct array *)BEGIN_CYCLIC(data,0)))
3a5b1d2000-05-24Fredrik Hübinette (Hubbe)  { add_ref(a); }else{
b0f8352001-01-07Henrik Grubbström (Grubba)  push_array(a=allocate_array(data->size));
3a5b1d2000-05-24Fredrik Hübinette (Hubbe)  SET_CYCLIC_RET(a); for(e=0;e<a->size;e++)
b0f8352001-01-07Henrik Grubbström (Grubba)  index_no_free(ITEM(a)+e, ITEM(data)+e, index);
3a5b1d2000-05-24Fredrik Hübinette (Hubbe)  sp--; } END_CYCLIC(); RETURN a; }
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); }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl int trace(int t) *! *! This function changes the debug trace level. *! *! The old level is returned. *! *! Trace level 1 or higher means that calls to Pike functions are *! printed to stderr, level 2 or higher means calls to builtin functions *! are printed, 3 means every opcode interpreted is printed, 4 means *! arguments to these opcodes are printed as well. *! *! See the @tt{-t@} command-line option for more information. */
098c802000-05-24Fredrik Hübinette (Hubbe) PIKEFUN int trace(int t) efun; optflags OPT_SIDE_EFFECT; { pop_n_elems(args); push_int(t_flag); t_flag=t; }
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. *! *! @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;
098c802000-05-24Fredrik Hübinette (Hubbe)  RETURN make_shared_string(ctime(&i)); }
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)
098c802000-05-24Fredrik Hübinette (Hubbe)  bad_arg_error("mkmapping", sp-args, args, 2, "array", sp+1-args, "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) 
269ef02001-04-18Martin Stjernholm /*! @decl int String.count(string haystack, string needle)
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) }
269ef02001-04-18Martin Stjernholm /*! @decl string String.trim_whites (string s)
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); }
269ef02001-04-18Martin Stjernholm /*! @decl string String.trim_all_whites (string s)
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); }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl int program_implements(program prog, program api) *! *! 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) }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl int program_inherits(program child, program parent) *! *! 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) }
85081b2001-02-27Martin Stjernholm /*! @decl string program_defined(program p)
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Returns a string with filename and linenumber describing where *! the program @[p] was defined. *! *! The returned string is of the format @tt{"@i{filename@}:@i{linenumber@}"@}. *! *! If it cannot be determined where the program was defined, @tt{0@} (zero) *! will be returned. */
b8c5b22000-05-25Fredrik Hübinette (Hubbe) PIKEFUN string program_defined(program p) errname Program.defined; optflags OPT_TRY_OPTIMIZE; { if(p && p->num_linenumbers) { char *tmp; INT32 line; if((tmp=get_line(p->program, p, &line))) { struct pike_string *tmp2; tmp2=make_shared_string(tmp); pop_n_elems(args); push_string(tmp2); if(line > 1) { push_constant_text(":"); push_int(line); f_add(3); } return; } } pop_n_elems(args); push_int(0); }
269ef02001-04-18Martin Stjernholm /*! @decl int(8..8)|int(16..16)|int(32..32) String.width(string s)
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()], *! that function will be called with @[index] as the signle argument. *! *! Other wise if @[map] is a mapping the entry with index @[index] *! will be removed from @[map] destructively. *! *! If the mapping does not have an entry with index @[index], nothing is done. *! *! @returns *! The value that was removed will be returned. *! *! @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); *sp=s; sp++; }
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 ) SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object with _m_delete"); 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)  */
9da7f42001-06-05Martin Stjernholm PIKEFUN int get_weak_flag(array|mapping|multiset m)
ee9fa92000-07-06Martin Stjernholm  efun;
8f998d2000-08-31Henrik Grubbström (Grubba)  optflags OPT_EXTERNAL_DEPEND;
ee9fa92000-07-06Martin Stjernholm {
37b8782000-11-02Henrik Grubbström (Grubba)  int flag = 0;
ee9fa92000-07-06Martin Stjernholm  switch (m->type) { case T_ARRAY:
9da7f42001-06-05Martin Stjernholm  flag = (m->u.array->flags & ARRAY_WEAK_FLAG) ? PIKE_WEAK_VALUES : 0;
ee9fa92000-07-06Martin Stjernholm  break; case T_MAPPING:
9da7f42001-06-05Martin Stjernholm  flag = mapping_get_flags(m->u.mapping) & MAPPING_WEAK;
ee9fa92000-07-06Martin Stjernholm  break; case T_MULTISET:
9da7f42001-06-05Martin Stjernholm  flag = (m->u.multiset->ind->flags & (ARRAY_WEAK_FLAG|ARRAY_WEAK_SHRINK)) ? PIKE_WEAK_INDICES : 0;
ee9fa92000-07-06Martin Stjernholm  break; default: SIMPLE_BAD_ARG_ERROR("get_weak_flag",1,"array|mapping|multiset"); } pop_n_elems(args); push_int(flag); }
aa68b12001-03-19Fredrik Hübinette (Hubbe) PIKEFUN program __empty_program() efun; optflags OPT_EXTERNAL_DEPEND; { RETURN low_allocate_program(); }
1c1c5e2001-04-08Fredrik Hübinette (Hubbe) /*! @decl string function_name(function f) *! *! Return the name of the function @[f]. *! *! If @[f] is a global function defined in the runtime @tt{0@} (zero) *! will be returned. *! *! @seealso *! @[function_object()] */ PIKEFUN string function_name(program|function func) efun; optflags OPT_TRY_OPTIMIZE; { struct pike_string *s; switch(func->type) { default: if(!func->u.object->prog) bad_arg_error("function_name", Pike_sp-args, args, 1, "function|program", Pike_sp-args, "Bad argument.\n"); 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; } } 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); } /*! @decl object function_object(function|program f) *! *! Return the object the function @[f] is in. *! *! If @[f] is a global function defined in the runtime @tt{0@} (zero) *! will be returned. *! *! @seealso *! @[function_name()] */
5a6d7d2001-04-10Fredrik Hübinette (Hubbe) PIKEFUN object|program function_object(object|program|function func)
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  efun; optflags OPT_TRY_OPTIMIZE;
5a6d7d2001-04-10Fredrik Hübinette (Hubbe)  type function(function|object:object)|function(program:program);
1c1c5e2001-04-08Fredrik Hübinette (Hubbe) { 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: 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); }
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) void init_builtin(void) {
ab82822000-05-25Fredrik Hübinette (Hubbe) INIT
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) }