/* -*- c -*- */ |
|
#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" |
#include "pike_error.h" |
#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" |
#include "main.h" |
#include "operators.h" |
|
/*! @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()] |
*/ |
PIKEFUN array column(array data, mixed index) |
efun; |
optflags OPT_TRY_OPTIMIZE; |
{ |
INT32 e; |
struct array *a; |
|
DECLARE_CYCLIC(); |
|
/* Optimization */ |
if(data->refs == 1) |
{ |
/* An array with one ref cannot possibly be cyclic */ |
struct svalue sval; |
data->type_field = BIT_MIXED | BIT_UNFINISHED; |
for(e=0;e<data->size;e++) |
{ |
index_no_free(&sval, ITEM(data)+e, index); |
free_svalue(ITEM(data)+e); |
ITEM(data)[e]=sval; |
} |
pop_stack(); |
return; |
} |
|
if((a=(struct array *)BEGIN_CYCLIC(data,0))) |
{ |
add_ref(a); |
}else{ |
push_array(a=allocate_array(data->size)); |
SET_CYCLIC_RET(a); |
|
for(e=0;e<a->size;e++) |
index_no_free(ITEM(a)+e, ITEM(data)+e, index); |
|
sp--; |
} |
END_CYCLIC(); |
RETURN a; |
} |
|
/*! @decl multiset mkmultiset(array a) |
*! |
*! This function creates a multiset from an array. |
*! |
*! @seealso |
*! @[aggregate_multiset()] |
*! |
*/ |
PIKEFUN multiset(1) mkmultiset(array(1=mixed) a) |
efun; |
optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND; |
{ |
RETURN mkmultiset(a); |
} |
|
/*! @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. |
*/ |
PIKEFUN int trace(int t) |
efun; |
optflags OPT_SIDE_EFFECT; |
{ |
pop_n_elems(args); |
push_int(t_flag); |
t_flag=t; |
} |
|
/*! @decl string ctime(int timestamp) |
*! |
*! 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) |
efun; |
optflags OPT_TRY_OPTIMIZE; |
{ |
time_t i=(time_t)timestamp; |
RETURN make_shared_string(ctime(&i)); |
} |
|
/*! @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()] |
*/ |
PIKEFUN mapping(1:2) mkmapping(array(1=mixed) ind, array(2=mixed) val) |
efun; |
optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND; |
{ |
if(ind->size != val->size) |
bad_arg_error("mkmapping", sp-args, args, 2, "array", sp+1-args, |
"mkmapping called on arrays of different sizes (%d != %d)\n", |
ind->size, val->size); |
|
RETURN mkmapping(ind, val); |
} |
|
/*! @decl int String.count(string haystack, string needle) |
*! |
*! Count the number of non-overlapping times the string @[needle] occurrs |
*! in the string @[haystack]. |
*! |
*! @seealso |
*! @[search()], @[`/()] |
*/ |
PIKEFUN int string_count(string haystack, string needle) |
errname String.count; |
optflags OPT_TRY_OPTIMIZE; |
{ |
ptrdiff_t c = 0; |
ptrdiff_t i, j; |
|
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; |
} |
RETURN DO_NOT_WARN((INT_TYPE)c); |
} |
|
/*! @decl string String.trim_whites (string s) |
*! |
*! 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); |
} |
|
/*! @decl string String.trim_all_whites (string s) |
*! |
*! 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); |
} |
|
/*! @decl int program_implements(program prog, program api) |
*! |
*! Returns 1 if @[prog] implements @[api]. |
*/ |
PIKEFUN int program_implements(program prog, program api) |
errname Program.implements; |
optflags OPT_TRY_OPTIMIZE; |
{ |
RETURN implements(prog, api); |
} |
|
/*! @decl int program_inherits(program child, program parent) |
*! |
*! Returns 1 if @[child] has inherited @[parent]. |
*/ |
PIKEFUN int program_inherits(program parent, program child) |
errname Program.inherits; |
optflags OPT_TRY_OPTIMIZE; |
{ |
RETURN low_get_storage(parent, child) != -1; |
} |
|
/*! @decl string program_defined(program p) |
*! |
*! 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. |
*/ |
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); |
} |
|
/*! @decl int(8..8)|int(16..16)|int(32..32) String.width(string s) |
*! |
*! 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 |
*/ |
PIKEFUN int(8 .. 8)|int(16 .. 16)|int(32 .. 32) string_width(string s) |
errname String.width; |
optflags OPT_TRY_OPTIMIZE; |
{ |
RETURN 8 * (1 << s->size_shift); |
} |
|
/*! @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()] |
*/ |
PIKEFUN mixed m_delete(object|mapping map, mixed index) |
efun; |
optflags OPT_SIDE_EFFECT; |
{ |
/*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++; |
} |
else if (map->type == T_OBJECT && map->u.object->prog) |
{ |
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 ); |
stack_swap(); |
pop_stack(); |
} else { |
SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object|mapping"); |
} |
} |
|
/*! @decl int(0..1) get_weak_flag(array|mapping|multiset m) |
*! |
*! Returns 1 if the weak flag has been set for @[m]. |
*/ |
PIKEFUN int(0 .. 1) get_weak_flag(array|mapping|multiset m) |
efun; |
optflags OPT_EXTERNAL_DEPEND; |
{ |
int flag = 0; |
switch (m->type) { |
case T_ARRAY: |
flag = !!(m->u.array->flags & ARRAY_WEAK_FLAG); |
break; |
case T_MAPPING: |
flag = !!(mapping_get_flags(m->u.mapping) & MAPPING_FLAG_WEAK); |
break; |
case T_MULTISET: |
flag = !!(m->u.multiset->ind->flags & (ARRAY_WEAK_FLAG|ARRAY_WEAK_SHRINK)); |
break; |
default: |
SIMPLE_BAD_ARG_ERROR("get_weak_flag",1,"array|mapping|multiset"); |
} |
pop_n_elems(args); |
push_int(flag); |
} |
|
PIKEFUN program __empty_program() |
efun; |
optflags OPT_EXTERNAL_DEPEND; |
{ |
RETURN low_allocate_program(); |
} |
|
/*! @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"); |
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; |
} |
|
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()] |
*/ |
PIKEFUN object|program function_object(object|program|function func) |
efun; |
optflags OPT_TRY_OPTIMIZE; |
type function(function|object:object)|function(program:program); |
{ |
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; |
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; |
} |
func->type=T_OBJECT; |
return; |
|
|
default: |
SIMPLE_BAD_ARG_ERROR("function_object",1,"function"); |
} |
pop_n_elems(args); |
push_int(0); |
} |
|
|
|
void init_builtin(void) |
{ |
INIT |
} |
|