63bd022001-06-08Martin Stjernholm /* -*- c -*-
2c20c72001-06-21Per Hedbor  * $Id: builtin.cmod,v 1.22 2001/06/21 01:23:07 per Exp $
63bd022001-06-08Martin Stjernholm  */
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"
63bd022001-06-08Martin Stjernholm #include "builtin_functions.h"
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) 
b0f8352001-01-07Henrik Grubbström (Grubba) //! 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()] //! 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; }
b0f8352001-01-07Henrik Grubbström (Grubba) //! 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); }
b0f8352001-01-07Henrik Grubbström (Grubba) //! 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; }
b0f8352001-01-07Henrik 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()] //! 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)); }
b0f8352001-01-07Henrik Grubbström (Grubba) //! 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()] //! 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) 
b0f8352001-01-07Henrik 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) }
b0f8352001-01-07Henrik Grubbström (Grubba) //! Returns 1 if @[prog] implements @[api]. //! 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) }
b0f8352001-01-07Henrik Grubbström (Grubba) //! Returns 1 if @[child] has inherited @[parent]. //! PIKEFUN int program_inherits(program child, program parent)
991fdf2000-05-25Fredrik Hübinette (Hubbe)  errname Program.inherits; optflags OPT_TRY_OPTIMIZE; {
404e632001-01-08Henrik Grubbström (Grubba)  RETURN !!low_get_storage(parent, child);
991fdf2000-05-25Fredrik Hübinette (Hubbe) }
b0f8352001-01-07Henrik 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); }
b0f8352001-01-07Henrik 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 //!
991fdf2000-05-25Fredrik Hübinette (Hubbe) PIKEFUN int string_width(string s) errname String.width; optflags OPT_TRY_OPTIMIZE; { RETURN 8 * (1 << s->size_shift); }
b0f8352001-01-07Henrik Grubbström (Grubba) //! Removes the entry with index @[index] from mapping @[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()] //!
a6078d2001-02-05Per Hedbor PIKEFUN mixed m_delete(object|mapping map, mixed index)
7f80d42000-06-19Fredrik Hübinette (Hubbe)  efun; optflags OPT_SIDE_EFFECT; {
a6078d2001-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++; }
da7fce2001-06-15Martin Stjernholm  else if (map->type == T_OBJECT)
a6078d2001-02-05Per Hedbor  {
da7fce2001-06-15Martin Stjernholm  int id = FIND_LFUN(map->u.object->prog, LFUN__M_DELETE); if( id == -1 ) SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object with _m_delete"); apply_low( map->u.object, id, 1 );
a6078d2001-02-05Per Hedbor  stack_swap(); pop_stack();
da7fce2001-06-15Martin Stjernholm  } else { SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object|mapping");
a6078d2001-02-05Per Hedbor  }
7f80d42000-06-19Fredrik Hübinette (Hubbe) }
63bd022001-06-08Martin Stjernholm //! Returns the weak flag settings for @[m]. It's a combination of //! @[Pike.WEAK_INDICES] and @[Pike.WEAK_VALUES].
b0f8352001-01-07Henrik Grubbström (Grubba) //!
63bd022001-06-08Martin 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:
63bd022001-06-08Martin Stjernholm  flag = (m->u.array->flags & ARRAY_WEAK_FLAG) ? PIKE_WEAK_VALUES : 0;
ee9fa92000-07-06Martin Stjernholm  break; case T_MAPPING:
63bd022001-06-08Martin Stjernholm  flag = mapping_get_flags(m->u.mapping) & MAPPING_WEAK;
ee9fa92000-07-06Martin Stjernholm  break; case T_MULTISET:
63bd022001-06-08Martin 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); }
4c68882001-06-21Per Hedbor #define INITIAL_BUF_LEN 4096 /*! @module String */ PIKECLASS Buffer /*! @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: *! *! @code{ *! String.Buffer b = String.Buffer( ); *! *! function add = b->add; *! *! .. call add several times in code ... *! *! string result = b->get(); // also clears the buffer *! @} */ { CVAR struct string_builder str; CVAR int initial; void f_Buffer_get_copy( INT32 args ); void f_Buffer_get( INT32 args ); void f_Buffer_add( INT32 args ); PIKEFUN void create( int|void size ) /*! @decl void create() *! *! Initializes a new buffer. *! *! If no @[initial_size] is specified, 4096 is used. If you *! know approximately how big the buffer will be, you can optimize *! the operation of @[add()] (slightly) by passing the size to this *! function. */ { struct Buffer_struct *str = THIS; if( args ) str->initial = MAXIMUM( size->u.integer, 512 ); else { str->initial = 256; push_int(0); } } 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 */)" ); if( str->str.s ) { push_int(str->str.s->len); push_int(str->str.malloced); } else { push_int( 0 ); push_int( 0 ); } f_sprintf( 3 ); 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; } PIKEFUN mixed cast( string type ) { struct pike_string *string_t; MAKE_CONSTANT_SHARED_STRING( string_t, "string" ); 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; } Pike_error("Cannot cast to %s\n", type->str ); } PIKEFUN object `+( string what ) { struct Buffer_struct *str = THIS, *str2; struct object *res = clone_object( Buffer_program, 0 ); if( str->str.s ) { str2 = OBJ2_BUFFER( res ); if( str2->str.s ) free_string_builder( &str2->str ); *str2 = *str; init_string_builder_alloc( &str2->str, str->str.malloced, str->str.s->size_shift ); MEMCPY( (void *)str2->str.s, (void *)str->str.s, str->str.malloced+sizeof(struct pike_string)); } apply( res, "add", 1 ); RETURN res; } PIKEFUN object `+=( string what ) { f_Buffer_add( 1 ); REF_RETURN fp->current_object; } PIKEFUN int add( string ... arg1 ) /*! @decl void add(string ... data) *! *! Adds @[data] to the buffer. Returns the size of the buffer. *! */ { struct Buffer_struct *str = THIS; int j; struct pike_string *a; for( j = 0; j<args; j++ ) { a = Pike_sp[-args+j].u.string; if( !str->str.s ) init_string_builder_alloc( &str->str, str->initial, a->size_shift ); string_builder_shared_strcat( &str->str, a ); } RETURN str->str.s->len; } PIKEFUN string get_copy() /*! @decl string get_copy() *! *! Get the data from the buffer. Significantly slower than @[get], *! but does not clear the buffer. */ { struct pike_string *str = THIS->str.s; if( str ) { ptrdiff_t len = str->len; if( len > 0 ) { char *d = (char *)str->str; switch( str->size_shift ) { case 0: RETURN make_shared_binary_string(d,len); break; case 1: RETURN make_shared_binary_string1((short*)d,len>>1); break; case 2: RETURN make_shared_binary_string2((int*)d,len>>2); break; } } } push_text(""); return; } PIKEFUN string get( ) /*! @decl string get() *! *! Get the data from the buffer. *! *! @note *! This will clear the data in the buffer */ { struct Buffer_struct *str = THIS;
e0c2342001-06-21Per Hedbor  if( str->str.s ) { struct pike_string *s = finish_string_builder( &str->str ); str->str.malloced = 0; str->str.s = 0; RETURN s; } pop_n_elems(args); push_text("");
2c20c72001-06-21Per Hedbor  return;
4c68882001-06-21Per Hedbor  } INIT { struct Buffer_struct *str = THIS; MEMSET( str, 0, sizeof( *str ) ); } EXIT { struct Buffer_struct *str = THIS; if( str->str.s ) free_string_builder( &str->str ); } } /* @endmodule */
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) void init_builtin(void) {
ab82822000-05-25Fredrik Hübinette (Hubbe) INIT
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) }