Diff of pike.git/src/builtin.cmod (b5e25ccf29dc4093c7db1455f24b43a71f3a3d1b » 489c0eb2c4d4a9c771edd100cf9292a24271ec2a)

pike.git/src/builtin.cmod:1:- /* -*- c -*- */ + /* -*- 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. + */ #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" - + #include "builtin_functions.h" + #include "fsort.h" + #include "port.h" + #include "gc.h" + #include "block_allocator.h" + #include "pikecode.h" + #include "opcodes.h" - //! 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) + #include <ctype.h> + #include <errno.h> + #include <math.h> + + DECLARATIONS + + + /*! @module System + */ + + #if defined(HAVE_MKTIME) && defined(HAVE_GMTIME) && defined(HAVE_LOCALTIME) + PIKECLASS TM + /*! @class TM + *! A wrapper for the system struct tm time keeping structure. + *! This can be used as a (very) lightweight alternative to Calendar. + */ + { + CVAR struct tm t; + CVAR time_t unix_time; + CVAR int modified; + CVAR struct pike_string *set_zone; + + #ifdef STRUCT_TM_HAS___TM_GMTOFF + #define tm_zone __tm_zone + #define tm_gmtoff __tm_gmtoff + #define GET_GMTOFF(TM) ((TM)->tm_gmtoff) + #define GET_ZONE(TM) ((TM)->tm_zone) + #define SET_GMTOFF(TM, VAL) (((TM)->tm_gmtoff) = (VAL)) + #define SET_ZONE(TM, VAL) (((TM)->tm_zone) = (VAL)) + #elif defined(STRUCT_TM_HAS_GMTOFF) + #define GET_GMTOFF(TM) ((TM)->tm_gmtoff) + #define GET_ZONE(TM) ((TM)->tm_zone) + #define SET_GMTOFF(TM, VAL) (((TM)->tm_gmtoff) = (VAL)) + #define SET_ZONE(TM, VAL) (((TM)->tm_zone) = (VAL)) + #else + #define GET_GMTOFF(TM) 0 + #define GET_ZONE(TM) ((char*)NULL) + #define SET_GMTOFF(TM, VAL) (VAL) + #define SET_ZONE(TM, VAL) (VAL) + #endif + + #if 0 + /* This is supposed to make any timezone work. + * However: It does not really work. And makes things even slower than + * the calendar module. + */ + #ifndef HAVE_EXTERNAL_TIMEZONE + #define timezone 0 + #endif + #define WITH_ZONE(RETURNTYPE, FUNCTION, ARGUMENTS, CALL ) \ + static RETURNTYPE FUNCTION##_zone ARGUMENTS \ + { \ + RETURNTYPE res; \ + int reset = 0; \ + char *old_zone = NULL; \ + if( GET_ZONE(x) ) \ + { \ + reset = 1; \ + old_zone = getenv("TZ"); \ + setenv("TZ", GET_ZONE(x), 1 ); \ + tzset(); \ + SET_GMTOFF(x, timezone); \ + } \ + \ + res = FUNCTION CALL; \ + \ + if( reset ) \ + { \ + if( old_zone ) \ + setenv("TZ", old_zone, 1 ); \ + else \ + unsetenv( "TZ" ); \ + tzset(); \ + } \ + return res; \ + } + + WITH_ZONE(time_t,mktime,( struct tm *x ),(x)); + WITH_ZONE(struct tm*,localtime,( time_t *t, struct tm *x ),(t)); + WITH_ZONE(char *,asctime,( struct tm *x ),(x)); + WITH_ZONE(int,strftime,( char *buffer, size_t max_len, char *format, struct tm *x ),(buffer,max_len,format,x)); + #ifdef HAVE_STRPTIME + WITH_ZONE(char *,strptime,( const char *str, const char *format, struct tm *x ),(str,format,x)); + #endif + #else + #define strftime_zone strftime + #define mktime_zone mktime + #define strptime_zone strptime + #define asctime_zone asctime + #define localtime_zone(X,Y) localtime(X) + #endif + #ifndef HAVE_EXTERNAL_TIMEZONE + #undef timezone + #endif + + #define MODIFY(X) do{ THIS->modified = 1;THIS->t.X; }while(0) + #define FIX_THIS() do { \ + if(THIS->modified){ \ + THIS->unix_time = mktime_zone( &THIS->t ); \ + THIS->modified = 0; \ + } \ + } while(0) + + #ifdef HAVE_STRPTIME + /* + *! @decl int(0..1) strptime( string(1..255) format, string(1..255) data ) + *! + *! Parse the given @[data] using the format in @[format] as a date. + *! + *! %% The % character. + *! + *! %a or %A + *! The weekday name according to the C locale, in abbreviated + *! form or the full name. + *! + *! %b or %B or %h + *! The month name according to the C locale, in abbreviated form + *! or the full name. + *! + *! %c The date and time representation for the C locale. + *! + *! %C The century number (0-99). + *! + *! %d or %e + *! The day of month (1-31). + *! + *! %D Equivalent to %m/%d/%y. + *! + *! %H The hour (0-23). + *! + *! %I The hour on a 12-hour clock (1-12). + *! + *! %j The day number in the year (1-366). + *! + *! %m The month number (1-12). + *! + *! %M The minute (0-59). + *! + *! %n Arbitrary whitespace. + *! + *! %p The C locale's equivalent of AM or PM. + *! + *! %R Equivalent to %H:%M. + *! + *! %S The second (0-60; 60 may occur for leap seconds; earlier also 61 was allowed). + *! + *! %t Arbitrary whitespace. + *! + *! %T Equivalent to %H:%M:%S. + *! + *! %U The week number with Sunday the first day of the week (0-53). + *! + *! %w The weekday number (0-6) with Sunday = 0. + *! + *! %W The week number with Monday the first day of the week (0-53). + *! + *! %x The date, using the C locale's date format. + *! + *! %X The time, using the C locale's time format. + *! + *! %y + *! The year within century (0-99). When a century is not + *! otherwise specified, values in the range 69-99 refer to years + *! in the twentieth century (1969-1999); values in the range + *! 00-68 refer to years in the twenty-first century (2000-2068). + *! + *! %Y The year, including century (for example, 1991). + *! + */ + PIKEFUN int(0..1) strptime( string(1..255) format, string(1..255) data ) + { + if( format->size_shift || data->size_shift ) + Pike_error("Only 8bit strings are supported\n"); + THIS->modified = 1; + if( strptime_zone( data->str, format->str, &THIS->t ) == NULL ) + RETURN 0; + RETURN 1; + } + #endif + /*! @decl string(1..255) strftime( string(1..255) format ) + *! See also @[Gettext.setlocale] + *! + *! Convert the structure to a string. + *! + *! %a The abbreviated weekday name according to the current locale + *! + *! %A The full weekday name according to the current locale. + *! + *! %b The abbreviated month name according to the current locale. + *! + *! %B The full month name according to the current locale. + *! + *! %c The preferred date and time representation for the current locale. + *! + *! %C The century number (year/100) as a 2-digit integer. + *! + *! %d The day of the month as a decimal number (range 01 to 31). + *! + *! %D Equivalent to %m/%d/%y. (for Americans only. Americans should note that in other countries %d/%m/%y is rather common. This means that in international context this format is ambiguous and should not be used.) + *! + *! %e Like %d, the day of the month as a decimal number, but a leading zero is replaced by a space. + *! + *! %E Modifier: use alternative format, see below. + *! + *! %F Equivalent to %Y-%m-%d (the ISO 8601 date format). (C99) + *! + *! %G The ISO 8601 week-based year (see NOTES) with century as a decimal number. The 4-digit year corresponding to the ISO week number (see %V). This has the same format and value as %Y, except that if the ISO week number belongs to the previous or next year, that year is used instead. + *! + *! %g Like %G, but without century, that is, with a 2-digit year (00-99). (TZ) + *! + *! %h Equivalent to %b. + *! + *! %H The hour as a decimal number using a 24-hour clock (range 00 to 23). + *! + *! %I The hour as a decimal number using a 12-hour clock (range 01 to 12). + *! + *! %j The day of the year as a decimal number (range 001 to 366). + *! + *! %k The hour (24-hour clock) as a decimal number (range 0 to 23); single digits are preceded by a blank. (See also %H.) + *! + *! %l The hour (12-hour clock) as a decimal number (range 1 to 12); single digits are preceded by a blank. (See also %I.) + *! + *! %m The month as a decimal number (range 01 to 12). + *! + *! %M The minute as a decimal number (range 00 to 59). + *! + *! %n A newline character. (SU) + *! + *! %O Modifier: use alternative format, see below. (SU) + *! + *! %p Either "AM" or "PM" according to the given time value, or the corresponding strings for the current locale. Noon is treated as "PM" and midnight as "AM". + *! + *! %P Like %p but in lowercase: "am" or "pm" or a corresponding string for the current locale. + *! + *! %r The time in a.m. or p.m. notation. In the POSIX locale this is equivalent to %I:%M:%S %p. + *! + *! %R The time in 24-hour notation (%H:%M). (SU) For a version including the seconds, see %T below. + *! + *! %s The number of seconds since the Epoch, 1970-01-01 00:00:00 +0000 (UTC). (TZ) + *! + *! %S The second as a decimal number (range 00 to 60). (The range is up to 60 to allow for occasional leap seconds.) + *! + *! %t A tab character. (SU) + *! + *! %T The time in 24-hour notation (%H:%M:%S). (SU) + *! + *! %u The day of the week as a decimal, range 1 to 7, Monday being 1. See also %w. (SU) + *! + *! %U The week number of the current year as a decimal number, range 00 to 53, starting with the first Sunday as the first day of week 01. See also %V and %W. + *! + *! %V The ISO 8601 week number of the current year as a decimal number, range 01 to 53, where week 1 is the first week that has at least 4 days in the new year. See also %U and %W. + *! + *! %w The day of the week as a decimal, range 0 to 6, Sunday being 0. See also %u. + */ + PIKEFUN string strftime(string(1..255) format) + { + char *buffer = xalloc( 8192 ); + buffer[0] = 0; + strftime_zone( buffer, 8192, format->str, &THIS->t ); + push_text( buffer ); + } + + /* + *! @decl int(0..60) sec; + *! @decl int(0..59) min; + *! @decl int(0..59) hour; + *! @decl int(1..31) mday; + *! @decl int(0..11) mon; + *! @decl int year; + *! + *! The various fields in the structure. Note that setting these + *! might cause other fields to be recalculated, as an example, + *! adding 1000 to the hour field would advance the 'mday', 'mon' + *! and possibly 'year' fields. + *! + *! When read the fields are always normalized. + *! + *! Unlike the system struct tm the 'year' field is not year-1900, + *! instead it is the actual year. + */ + PIKEFUN int(0..60) `sec() { FIX_THIS();RETURN THIS->t.tm_sec; } + PIKEFUN int(0..59) `min() { FIX_THIS();RETURN THIS->t.tm_min; } + PIKEFUN int(0..23) `hour() { FIX_THIS();RETURN THIS->t.tm_hour; } + PIKEFUN int(1..31) `mday() { FIX_THIS();RETURN THIS->t.tm_mday; } + PIKEFUN int(0..11) `mon() { FIX_THIS();RETURN THIS->t.tm_mon; } + PIKEFUN int `year() { FIX_THIS();RETURN THIS->t.tm_year+1900; } + + PIKEFUN int `sec=(int a) { MODIFY(tm_sec=a); } + PIKEFUN int `min=(int a) { MODIFY(tm_min=a); } + PIKEFUN int `hour=(int a){ MODIFY(tm_hour=a); } + PIKEFUN int `mday=(int a){ MODIFY(tm_mday=a); } + PIKEFUN int `year=(int a){ MODIFY(tm_year=a-1900); } + PIKEFUN int `mon=(int a){ MODIFY(tm_mon=a); } + + /*! @decl int isdst + *! + *! True if daylight savings are in effect. If this field is -1 + *! (the default) it (and the timezone info) will be updated + *! automatically using the timezone rules. + */ + PIKEFUN int(-1..1) `isdst() { + FIX_THIS(); + RETURN THIS->t.tm_isdst; + } + + /*! @decl int wday + *! The day of the week, sunday is 0, saturday is 6. + *! This is calculated from the other fields and can not be changed directly. + */ + PIKEFUN int(0..6) `wday() { FIX_THIS(); RETURN THIS->t.tm_wday; } + + /*! @decl int yday + *! The day of the year, from 0 (the first day) to 365 + *! This is calculated from the other fields and can not be changed directly. + */ + PIKEFUN int(0..365) `yday() { FIX_THIS(); RETURN THIS->t.tm_yday; } + + /*! @decl int unix_time() + *! Return the unix time corresponding to this time_t. If no time + *! can be parsed from the structure -1 is returned. + */ + PIKEFUN int unix_time() + { + FIX_THIS(); + RETURN THIS->unix_time; + } + + /*! @decl string asctime() + *! Return a string representing the time. Mostly useful for debug + *! purposes, the exact format is very locale (see + *! @[Gettext.setlocale]) and OS dependent. + */ + PIKEFUN string asctime() + { + FIX_THIS(); + { + char *tval = asctime_zone( &THIS->t ); + if( tval ) + push_text( tval ); + else + push_text( 0 ); + } + } + + PIKEFUN void _sprintf( int flag, mapping options ) + { + int post_sum = 1; + switch( flag ) + { + case 'O': + push_text("System.TM("); + post_sum = 1; + /* fallthrough */ + case 's': + f_TM_asctime(0); + push_text("\n"); + if( GET_ZONE(&(THIS->t)) ) + { + push_text(" "); + push_text( GET_ZONE(&(THIS->t)) ); + f_add( 2 ); + } + else + push_text(""); + f_replace( 3 ); + break; + case 'd': + f_TM_unix_time(0); + break; + default: + Pike_error("Can not format as %c", flag ); + } + if( post_sum ) + { + push_text(")"); + f_add(3); + } + + } + + PIKEFUN mixed cast( string to ) + { + struct pike_string *s_string, *s_int; + MAKE_CONST_STRING(s_int, "int"); + MAKE_CONST_STRING(s_string, "string"); + if( to == s_int ) + { + f_TM_unix_time(0); + return; + } + if( to == s_string ) + { + f_TM_asctime(0); + return; + } + Pike_error("Does not know how to cast to %s\n", to->str ); + } + + /*! @decl string zone + *! + *! The timezone of this structure + */ + PIKEFUN string `zone() { + FIX_THIS(); + if( GET_ZONE(&(THIS->t)) ) + push_text( GET_ZONE(&(THIS->t)) ); + else + push_undefined(); + } + + /*! @decl int gmtoff + *! The offset from GMT for the time in this tm-struct + */ + PIKEFUN int `gmtoff() { + FIX_THIS(); + push_int( GET_GMTOFF(&(THIS->t)) ); + } + + /* Setting the zone does not work, so.. */ + + /* PIKEFUN string `zone=(string x) { */ + /* if( THIS->set_zone ) */ + /* free_string( THIS->set_zone ); */ + /* THIS->set_zone = x; */ + /* MODIFY( tm_zone = x->str ); */ + /* x->refs++; */ + /* } */ + + /*! @decl int(0..1) localtime( int time ) + *! Initialize the struct tm to the local time for the specified + *! unix time_t. + */ + PIKEFUN int(0..1) localtime( int _t ) + { + time_t t = _t; + struct tm *res = localtime_zone( &t, &THIS->t ); + + /* These are supposedly correctly by localtime_zone. */ + SET_GMTOFF(res, GET_GMTOFF(&(THIS->t))); + SET_ZONE(res, GET_ZONE(&(THIS->t))); + + if( !res ) + RETURN 0; + THIS->t = *res; + THIS->modified = 1; + RETURN 1; + } + + + /*! @decl int(0..1) gmtime( int time ) + *! Initialize the struct tm to the UTC time for the specified + *! unix time_t. + */ + PIKEFUN int(0..1) gmtime( int _t ) + { + time_t t = _t; + struct tm *res = gmtime( &t ); + + if( !res ) + RETURN 0; + + THIS->t = *res; + THIS->modified = 1; + RETURN 1; + } + + /*! @decl void create(int t) + *! Create a new @[TM] initialized from a unix time_t. + *! The timezone will always be UTC when using this function. + */ + PIKEFUN void create( int _t ) + { + f_TM_gmtime( 1 ); + if( Pike_sp[-1].u.integer == 0 ) + Pike_error("time out of range\n"); + } + + /*! @decl void create() + *! Construct a new TM, all fields will be set to 0. + */ + PIKEFUN void create( ) + { + memset( &THIS->t, 0, sizeof( struct tm ) ); + THIS->t.tm_isdst = -1; + THIS->unix_time = 0; + THIS->modified = 1; + } + + /*! @decl void create( int year, int(0..11) mon, int(1..31) mday, @ + *! int(0..24) hour, int(0..59) min, int(0..59) sec, @ + *! string|void timezone ) + *! Construct a new time using the given values. + *! Slightly faster than setting them individually. + */ + PIKEFUN void create( int year, int(0..11) mon, int(1..31) mday, + int(0..24) hour, int(0..59) min, int(0..59) sec, + string|void timezone ) + { + struct tm *t = &THIS->t; + t->tm_isdst = -1; + t->tm_year = year - 1900; + t->tm_mon = mon; + t->tm_mday = mday; + t->tm_hour = hour; + t->tm_min = min; + t->tm_sec = sec; + if (THIS->set_zone) { + free_string(THIS->set_zone); + THIS->set_zone = NULL; + } + if( !timezone ) /* gmtime. */ + SET_ZONE(t, "UTC"); + else + { + add_ref(timezone); + THIS->set_zone = timezone; + SET_ZONE(t, timezone->str); + } + THIS->unix_time = mktime_zone( t ); + } + + INIT { + THIS->set_zone = 0; + THIS->modified = 0; + } + + EXIT { + if( THIS->set_zone ) + free_string( THIS->set_zone ); + } + } + #undef FIX_THIS + #ifdef STRUCT_TM_HAS___TM_GMTOFF + #undef tm_zone + #undef tm_gmtoff + #endif + #endif + /*! @endmodule + */ + + /*! @decl array(array(int|string|type)) describe_program(program p) + *! @belongs Debug + *! + *! Debug function for showing the symbol table of a program. + *! + *! @returns + *! Returns an array of arrays with the following information + *! for each symbol in @[p]: + *! @array + *! @elem int modifiers + *! Bitfield with the modifiers for the symbol. + *! @elem string symbol_name + *! Name of the symbol. + *! @elem type value_type + *! Value type for the symbol. + *! @elem int symbol_type + *! Type of symbol. + *! @elem int symbol_offset + *! Offset into the code or data area for the symbol. + *! @elem int inherit_offset + *! Offset in the inherit table to the inherit containing + *! the symbol. + *! @elem int inherit_level + *! Depth in the inherit tree for the inherit containing + *! the symbol. + *! @endarray + *! + *! @note + *! The API for this function is not fixed, and has changed + *! since Pike 7.6. In particular it would make sense to return + *! an array of objects instead, and more information about the + *! symbols might be added. + */ + PMOD_EXPORT + PIKEFUN array(array(int|string)) _describe_program(mixed x) efun; - + { + struct program *p; + struct array *res; + int i; + + if (!(p = program_from_svalue(Pike_sp - args))) + SIMPLE_BAD_ARG_ERROR("_describe_program", 1, "program"); + + 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); + struct inherit *inh = INHERIT_FROM_PTR(p, ref); + push_int(ref->id_flags); + ref_push_string(id->name); + ref_push_type_value(id->type); + push_int(id->identifier_flags); + if (IDENTIFIER_IS_C_FUNCTION(id->identifier_flags)) { + push_int(-2); + } else { + push_int(id->func.offset); + } + push_int(ref->inherit_offset); + push_int(inh->inherit_level); + f_aggregate(7); + } + f_aggregate(p->num_identifier_references); + dmalloc_touch_svalue(Pike_sp-1); + res = Pike_sp[-1].u.array; + Pike_sp--; + pop_n_elems(args); + push_array(res); + } + + /*! @decl string basetype(mixed x) + *! + *! Same as sprintf("%t",x); + *! + *! @seealso + *! @[sprintf()] + */ + PMOD_EXPORT + PIKEFUN string basetype(mixed x) + efun; optflags OPT_TRY_OPTIMIZE; { - INT32 e; - struct array *a; + int t = TYPEOF(*x); + struct program *p; + if(t == T_OBJECT && (p = x->u.object->prog)) + { + ptrdiff_t fun = FIND_LFUN(p->inherits[SUBTYPEOF(*x)].prog, LFUN__SPRINTF); + if(fun != -1) + { + push_int('t'); + f_aggregate_mapping(0); + apply_low(x->u.object, + fun + p->inherits[SUBTYPEOF(*x)].identifier_level, 2); + if(TYPEOF(Pike_sp[-1]) == T_STRING) + { + stack_swap(); + pop_stack(); + return; + } else if (UNSAFE_IS_ZERO(Pike_sp-1)) { + pop_n_elems(2); + push_constant_text("object"); + return; + } else { + Pike_error("Non-string returned from _sprintf()\n"); + } + } + } + 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; + /* 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; + case T_MAPPING_DATA: push_constant_text("mapping_data"); break; + case T_PIKE_FRAME: push_constant_text("pike_frame"); break; + case T_MULTISET_DATA: push_constant_text("multiset_data"); break; + default: push_constant_text("unknown"); break; + } + } - DECLARE_CYCLIC(); + - /* Optimization */ - if(data->refs == 1) + /*! @decl string int2char(int x) + *! @appears String.int2char + *! + *! Same as sprintf("%c",x); + *! + *! @seealso + *! @[sprintf()] + */ + PMOD_EXPORT + PIKEFUN string int2char(int|object x) + efun; + optflags OPT_TRY_OPTIMIZE; { - /* 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++) + int c; + struct program *p; + if(TYPEOF(*x) == T_OBJECT && (p = x->u.object->prog)) { - index_no_free(&sval, ITEM(data)+e, index); - free_svalue(ITEM(data)+e); - ITEM(data)[e]=sval; + ptrdiff_t fun = FIND_LFUN(p->inherits[SUBTYPEOF(*x)].prog, LFUN__SPRINTF); + if(fun != -1) + { + push_int('c'); + f_aggregate_mapping(0); + apply_low(x->u.object, + fun + p->inherits[SUBTYPEOF(*x)].identifier_level, 2); + if(TYPEOF(Pike_sp[-1]) == T_STRING) + { + stack_swap(); + pop_stack(); + return; } - + Pike_error("Non-string returned from _sprintf()\n"); + } + } + if(TYPEOF(*x) != T_INT) + SIMPLE_BAD_ARG_ERROR("int2char", 1, "int"); + + 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); + } + } + + /*! @decl string int2hex(int x) + *! @appears String.int2hex + *! + *! Same as @expr{sprintf("%x",x);@}, i.e. returns the integer @[x] in + *! hexadecimal base using lower cased symbols. + *! + *! @seealso + *! @[sprintf()] + */ + PMOD_EXPORT + PIKEFUN string int2hex(int|object x) + efun; + optflags OPT_TRY_OPTIMIZE; + { + INT_TYPE c; + unsigned INT_TYPE n; + int len; + struct pike_string *s; + struct program *p; + + if(TYPEOF(*x) == T_OBJECT && (p = x->u.object->prog)) + { + ptrdiff_t fun = FIND_LFUN(p->inherits[SUBTYPEOF(*x)].prog, LFUN__SPRINTF); + if(fun != -1) + { + push_int('x'); + f_aggregate_mapping(0); + apply_low(x->u.object, + fun + p->inherits[SUBTYPEOF(*x)].identifier_level, 2); + if(TYPEOF(Pike_sp[-1]) == T_STRING) + { + stack_swap(); pop_stack(); return; } - + Pike_error("Non-string returned from _sprintf()\n"); + } + } + if(TYPEOF(*x) != T_INT) + SIMPLE_BAD_ARG_ERROR("int2hex", 1, "int"); - if((a=(struct array *)BEGIN_CYCLIC(data,0))) + c=x->u.integer; + + len=1; + if(c<0) { + len++; + n=(-c)&((unsigned INT_TYPE)(-1)); + }else{ + n=c; + } + while(n>65535) { n>>=16; len+=4; } + while(n>15) { n>>=4; len++; } + + s=begin_shared_string(len); + if(!c) { - add_ref(a); + s->str[0]='0'; }else{ - push_array(a=allocate_array(data->size)); - SET_CYCLIC_RET(a); + if(c<0) + { + s->str[0]='-'; + n=(-c)&((unsigned INT_TYPE)(-1)); + }else{ + n=c; + } + while(len && n) + { + s->str[--len]="0123456789abcdef"[n&0xf]; + n>>=4; + } + } + RETURN end_shared_string(s); + } - for(e=0;e<a->size;e++) - index_no_free(ITEM(a)+e, ITEM(data)+e, index); + - sp--; + /*! @decl string string2hex(string data) + *! @appears String.string2hex + *! + *! Convert a string of binary data to a hexadecimal string. + *! + *! @seealso + *! @[hex2string()] + */ + + static const char hexchar[] = { + '0','1','2','3','4','5','6','7','8','9', + 'a','b','c','d','e','f' + }; + + static const unsigned char hexdecode[256] = + { + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + + /* '0' - '9' */ + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, + + 0,0,0,0,0,0,0, + + /* 'A' - 'F' */ + 10, 11, 12, 13, 14, 15, + + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + /* 'a' - 'f' */ + 10, 11, 12, 13, 14, 15, + }; + + PMOD_EXPORT + PIKEFUN string string2hex(string s) + errname String.string2hex; + optflags OPT_TRY_OPTIMIZE; + { + struct pike_string *hex; + unsigned char *p,*st = (unsigned char *)s->str; + int i, l; + + if (s->size_shift) + Pike_error("Bad argument 1 to string2hex(), expected 8-bit string.\n"); + + hex = begin_shared_string(2 * s->len); + p = (unsigned char *)hex->str; + l = s->len; + + for (i=0; i<l; i++) { + *p++ = hexchar[*st>>4]; + *p++ = hexchar[*st&15]; + st++; } - END_CYCLIC(); - RETURN a; + + RETURN end_shared_string(hex); } - //! This function creates a multiset from an array. - //! - //! @seealso - //! @[aggregate_multiset()] - //! + /*! @decl string hex2string(string hex) + *! @appears String.hex2string + *! + *! Convert a string of hexadecimal digits to binary data. + *! + *! @seealso + *! @[string2hex()] + */ + PMOD_EXPORT + PIKEFUN string hex2string(string hex) + errname String.hex2string; + optflags OPT_TRY_OPTIMIZE; + { + struct pike_string *s; + int tmp, i; + unsigned char *p, *q = (unsigned char *)hex->str; + int l = hex->len>>1; + if(hex->size_shift) Pike_error("Only hex digits allowed.\n"); + if(hex->len&1) Pike_error("Can't have odd number of digits.\n"); + + s = begin_shared_string(l); + p = (unsigned char *)s->str; + for (i=0; i<l; i++) + { + tmp = hexdecode[*q++]; + *p++ = (tmp<<4) | hexdecode[*q++]; + } + RETURN end_shared_string(s); + } + + /*! @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]) + *! @endcode + *! + *! 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()] + */ + PMOD_EXPORT + PIKEFUN array column(array data, mixed index) + efun; + optflags OPT_TRY_OPTIMIZE; + { + RETURN array_column (data, index, 1); + } + + /*! @decl multiset mkmultiset(array a) + *! + *! This function creates a multiset from an array. + *! + *! @seealso + *! @[aggregate_multiset()] + *! + */ + PMOD_EXPORT PIKEFUN multiset(1) mkmultiset(array(1=mixed) a) efun; optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND; { RETURN mkmultiset(a); } - //! 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) + /*! @decl int trace(int level, void|string facility, void|int all_threads) + *! + *! 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. + *! + *! 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. + *! + *! See the @tt{-t@} command-line option for more information. + *! + *! @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 + *! @value 1 + *! Trace calls to Pike functions and garbage collector runs. + *! @value 2 + *! Trace calls to builtin functions. + *! @value 3 + *! Trace every interpreted opcode. + *! @value 4 + *! Also trace the opcode arguments. + *! @endint + *! + *! @param facility + *! Valid facilities are: + *! + *! @string + *! @value "gc" + *! Trace the doings of the garbage collector. The setting is + *! never thread local. @[level] has two different meanings: + *! @dl + *! @item 1..2 + *! Trace the start and end of each gc run. + *! @item 3.. + *! Additionally show info about the collected garbage, to aid + *! hunting down garbage problems. This currently shows gc'd + *! trampolines. Note that the output can be very bulky and is + *! somewhat low-level technical. Also note that pike currently + *! has to be configured with @expr{--with-rtldebug@} to enable + *! this. + *! @enddl + *! @endstring + *! + *! @param all_threads + *! 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. + *! + *! @returns + *! The old trace level in the current thread is returned. + */ + PMOD_EXPORT + PIKEFUN int trace(int level, void|string facility, void|zero|int all_threads) efun; optflags OPT_SIDE_EFFECT; { - pop_n_elems(args); - push_int(t_flag); - t_flag=t; + INT32 old_level; + if (facility) { + struct pike_string *gc_str; + MAKE_CONST_STRING(gc_str, "gc"); + if (facility == 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."); + } + } + else { + old_level = Pike_interpreter.trace_level; + #ifdef PIKE_THREADS + if (!all_threads) + Pike_interpreter.trace_level = level; + else { + struct thread_state *s; + FOR_EACH_THREAD(s, s->state.trace_level = level); + } + #else + Pike_interpreter.trace_level = level; + #endif + } + RETURN old_level; + } - //! 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) + /*! @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" + *! 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. + *! @member float "garbage_ratio_low" + *! As long as the gc time is less than time_ratio below, 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 time is spent in the gc, aim + *! for garbage_ratio_high instead of 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 "min_gc_time_ratio" + *! This puts an upper limit on the gc interval, in addition to the + *! factors above. It is specified as the minimum amount of time + *! spent doing gc, as a factor of the total time. The reason for + *! this limit is that the current amount of garbage can only be + *! measured in a gc run, and if the gc starts to run very seldom + *! due to very little garbage, it might get too slow to react to an + *! increase in garbage generation. Set to 0.0 to turn this limit + *! off. + *! @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. + *! @member function(:void) "pre_cb" + *! This function is called when the gc starts. + *! @member function(:void) "post_cb" + *! This function is called when the mark and sweep pass of the gc + *! is done. + *! @member function(object:void) "destruct_cb" + *! This function is called once for each object that is part of + *! a cycle just before the gc will destruct it. + *! @member function(int:void) "done_cb" + *! This function is called when the gc is done and about to exit. + *! The argument is the same value as will be returned by gc(). + *! @endmapping + *! + *! @seealso + *! @[gc], @[Debug.gc_status] + */ + PMOD_EXPORT + 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 (6)); + params = Pike_sp[-1].u.mapping; + } + + #define HANDLE_PARAM(NAME, CHECK_AND_SET, GET) do { \ + MAKE_CONST_STRING (str, NAME); \ + if ((set = low_mapping_string_lookup (params, str))) { \ + CHECK_AND_SET; \ + } \ + else { \ + GET; \ + mapping_string_insert (params, str, &get); \ + } \ + } while (0) + + #define HANDLE_FLOAT_FACTOR(NAME, VAR) \ + HANDLE_PARAM (NAME, { \ + if (TYPEOF(*set) != T_FLOAT || \ + set->u.float_number < 0.0 || set->u.float_number > 1.0) \ + SIMPLE_BAD_ARG_ERROR ("Pike.gc_parameters", 1, \ + "float between 0.0 and 1.0 for " NAME); \ + VAR = DO_NOT_WARN ((double) set->u.float_number); \ + }, { \ + SET_SVAL(get, T_FLOAT, 0, float_number, \ + DO_NOT_WARN ((FLOAT_TYPE) VAR)); \ + }); + + HANDLE_PARAM ("enabled", { + if (TYPEOF(*set) != 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) { + if (gc_enabled > 0) { + /* Disabling automatic gc - save the old alloc_threshold and set it to + * the maximum value to avoid getting gc_evaluator_callback added. */ + saved_alloc_threshold = alloc_threshold; + alloc_threshold = GC_MAX_ALLOC_THRESHOLD; + } + else if (set->u.integer > 0) { + /* Enabling automatic gc - restore the old alloc_threshold. If the + * gc interval has gotten longer than it should be then the + * multiplier calculation in do_gc should compensate. */ + alloc_threshold = saved_alloc_threshold; + } + gc_enabled = set->u.integer; + } + }, { + SET_SVAL(get, T_INT, NUMBER_NUMBER, 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 ("min_gc_time_ratio", gc_min_time_ratio); + HANDLE_FLOAT_FACTOR ("average_slowness", gc_average_slowness); + + HANDLE_PARAM("pre_cb", { + assign_svalue(&gc_pre_cb, set); + }, { + assign_svalue(&get, &gc_pre_cb); + }); + HANDLE_PARAM("post_cb", { + assign_svalue(&gc_post_cb, set); + }, { + assign_svalue(&get, &gc_post_cb); + }); + HANDLE_PARAM("destruct_cb", { + assign_svalue(&gc_destruct_cb, set); + }, { + assign_svalue(&get, &gc_destruct_cb); + }); + HANDLE_PARAM("done_cb", { + assign_svalue(&gc_done_cb, set); + }, { + assign_svalue(&get, &gc_done_cb); + }); + + #undef HANDLE_PARAM + #undef HANDLE_FLOAT_FACTOR + + REF_RETURN params; + } + + /*! @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. + *! + *! 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]. + *! + *! @seealso + *! @[time()], @[localtime()], @[mktime()], @[gmtime()] + */ + PMOD_EXPORT + PIKEFUN string ctime(longest timestamp) efun; optflags OPT_TRY_OPTIMIZE; { - time_t i=(time_t)timestamp; - RETURN make_shared_string(ctime(&i)); + time_t i; + char *s; + + #if SIZEOF_TIME_T < SIZEOF_LONGEST + if (timestamp > MAX_TIME_T || timestamp < MIN_TIME_T) + SIMPLE_ARG_ERROR ("ctime", 1, "Timestamp outside valid range."); + #endif + + i = (time_t) timestamp; + s = ctime (&i); + if (!s) Pike_error ("ctime() on this system cannot handle " + "the timestamp %ld.\n", (long) i); + RETURN make_shared_string(s); } - //! 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()] - //! + /*! @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()] + */ + PMOD_EXPORT 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, + bad_arg_error("mkmapping", Pike_sp-args, args, 2, "array", Pike_sp+1-args, "mkmapping called on arrays of different sizes (%d != %d)\n", ind->size, val->size); RETURN mkmapping(ind, val); } - //! Count the number of non-overlapping times the string @[needle] occurrs - //! in the string @[haystack]. - //! - //! @seealso - //! @[search()], @[`/()] - //! + /*! @decl void secure(string str) + *! @belongs String + *! + *! Marks the string as secure, which will clear the memory area + *! before freeing the string. + */ + PIKEFUN string string_secure(string str) + optflags OPT_SIDE_EFFECT; + rawtype tFunc(tSetvar(0, tStr), tVar(0)); + { + str->flags |= STRING_CLEAR_ON_EXIT; + REF_RETURN str; + } + + /*! @decl int count(string haystack, string needle) + *! @belongs String + *! + *! Count the number of non-overlapping times the string @[needle] + *! occurs in the string @[haystack]. The special cases for the needle + *! @expr{""@} is that it occurs one time in the empty string, zero + *! times in a one character string and between every character + *! (length-1) in any other string. + *! + *! @seealso + *! @[search()], @[`/()] + */ + PMOD_EXPORT 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? */ - + /* It is already fairly optimized in pike_search_engine. */ 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); } - //! Returns 1 if @[prog] implements @[api]. - //! + /*! @decl string trim_whites (string s) + *! @belongs String + *! + *! Trim leading and trailing spaces and tabs from the string @[s]. + */ + PMOD_EXPORT + 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 normalize_space (string s, string|void whitespace) + *! @belongs String + *! + *! @param s + *! Is returned after white space in it has been normalised. + *! White space is normalised by stripping leading and trailing white space + *! and replacing sequences of white space characters with a single space. + *! + *! @param whitespace + *! Defines what is considered to be white space eligible for normalisation. + *! It has a default value that starts with @expr{" \t\r\n\v\f"@} and in + *! addition to that contains all whitespace characters part of Unicode. + *! The first character denotes the character for replacing whitespace + *! sequences. + *! + *! @note + *! Trailing and leading whitespace around \r and \n characters + *! is stripped as well (only useful if they're not in the @[whitespace] set). + *! + *! @note + *! This function is a lot faster with just one argument (i.e. the builtin + *! whitespace set has an optimised code path). + */ + PMOD_EXPORT + PIKEFUN string string_normalize_space (string s, string|void whitespace) + errname String.normalize_space; + optflags OPT_TRY_OPTIMIZE; + { + size_t len = s->len, wlen; + const void *src = s->str; + unsigned shift = s->size_shift, replspace; + const void *ws; + void *wstemp = 0; + struct string_builder sb; + unsigned foundspace = 0; + + wlen = replspace = 0; /* useless, but suppresses silly compiler warning */ + + { + unsigned bshift = shift, wshift; + if(whitespace) + if(!(wlen = whitespace->len)) + REF_RETURN s; + else { + ws = whitespace->str; wshift = whitespace->size_shift; + replspace = index_shared_string(whitespace, 0); + if(replspace > 0xffff) + bshift = 2; + else if(replspace > 0xff && !bshift) + bshift = 1; + if(wshift!=shift) { /* convert whitespace to shift of input */ + PCHARP pcnws; + wstemp = xalloc(wlen<<shift); + pcnws = MKPCHARP(wstemp, shift); + if(wshift>shift) { + PCHARP pcows = MKPCHARP_STR(whitespace); + size_t clen = wlen, i; + i = wlen = 0; + do { + unsigned chr = INDEX_PCHARP(pcows, i++); + if (chr<=0xff || (chr<=0xffff && shift)) /* shift is 0 or 1 */ + SET_INDEX_PCHARP(pcnws, wlen++, chr); + } while(--clen); + } else + pike_string_cpy(pcnws, whitespace); + ws = wstemp; + } + } + else + ws = 0; + + init_string_builder_alloc (&sb, len, bshift); + if(bshift == shift) + sb.known_shift = bshift; + } + #define SPACECASE8 \ + case ' ':case '\t':case '\r':case '\n':case '\v':case '\f': \ + case 0x85:case 0xa0: + #include "whitespace.h" + + switch (shift) { + #define NORMALISE_TIGHT_LOOP(TYPE,CASE) \ + { \ + const TYPE *start = src, *end = start+len; \ + if (!ws) { \ + TYPE *dst = (void*)sb.s->str; \ + for (; start < end; start++) { \ + switch(*start) { \ + CASE \ + continue; \ + } \ + break; \ + } \ + for (; start < end; start++) { \ + if(*start<=' ' || *start>=0x85) /* optimise common case */ \ + switch(*start) { \ + CASE \ + if (!foundspace) \ + *dst++ = ' ', foundspace=1; \ + continue; \ + default:goto found##TYPE; \ + } \ + else \ + found##TYPE: \ + foundspace=0; \ + *dst++ = *start; \ + } \ + sb.s->len = dst - (TYPE*)sb.s->str; \ + } else { \ + const TYPE*ps = (const TYPE*)ws+wlen; \ + for (; start < end; start++) { \ + size_t clen = wlen; \ + do { \ + if (ps[0-clen] == *start) \ + goto lead##TYPE; \ + } while(--clen); \ + break; \ + lead##TYPE:; \ + } \ + for (; start < end; start++) { \ + TYPE chr = *start; \ + size_t clen = wlen; \ + do \ + if (ps[0-clen] == chr) { \ + if (!foundspace) \ + string_builder_putchar(&sb, replspace), foundspace=1; \ + goto skip##TYPE; \ + } \ + while(--clen); \ + if (foundspace && (chr=='\n' || chr=='\r')) { \ + sb.s->len--; string_builder_putchar(&sb, chr); \ + foundspace=0; \ + goto lead##TYPE; \ + } \ + string_builder_putchar(&sb, chr); foundspace=0; \ + skip##TYPE:; \ + } \ + } \ + } + case 0: NORMALISE_TIGHT_LOOP (p_wchar0,SPACECASE8); break; + case 1: NORMALISE_TIGHT_LOOP (p_wchar1,SPACECASE16); break; + case 2: NORMALISE_TIGHT_LOOP (p_wchar2,SPACECASE16); break; + #undef NORMALISE_TIGHT_LOOP + #undef SPACECASE8 + #undef SPACECASE16 + } + if (wstemp) + free(wstemp); + if (foundspace) + sb.s->len--; + RETURN finish_string_builder (&sb); + } + + /*! @decl string trim_all_whites (string s) + *! @belongs String + *! + *! Trim leading and trailing white spaces characters (space, tab, + *! newline, carriage return, form feed, vertical tab and all the + *! white spaces defined in Unicode) from the string @[s]. + */ + PMOD_EXPORT + 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 SPACECASE8 \ + case ' ':case '\t':case '\r':case '\n':case '\v':case '\f': \ + case 0x85:case 0xa0: + #include "whitespace.h" + + #define DO_IT(TYPE,CASE) \ + { \ + for (; start < end; start++) { \ + chr = ((TYPE *) s->str)[start]; \ + switch(chr) { \ + CASE \ + continue; \ + } \ + break; \ + } \ + while (--end > start) { \ + chr = ((TYPE *) s->str)[end]; \ + switch(chr) { \ + CASE \ + continue; \ + } \ + break; \ + } \ + } + case 0: DO_IT (p_wchar0,SPACECASE8); break; + case 1: DO_IT (p_wchar1,SPACECASE16); break; + case 2: DO_IT (p_wchar2,SPACECASE16); break; + #undef DO_IT + #undef SPACECASE8 + #undef SPACECASE16 + } + RETURN string_slice (s, start, end + 1 - start); + } + + /*! @decl string status(int verbose) + *! @belongs String + *! + *! Get string table statistics. + *! + *! @returns + *! Returns a string with an ASCII table containing + *! the current string table statistics. + *! + *! @note + *! Currently returns the empty string (@expr{""@}) + *! if @[verbose] is zero. + *! + *! @note + *! The formatting and contents of the result + *! may vary between different versions of Pike. + */ + PIKEFUN string string_status(int verbose) + errname String.status; + { + RETURN add_string_status(verbose); + } + + /*! @decl int implements(program prog, program api) + *! @belongs Program + *! + *! Returns 1 if @[prog] implements @[api]. + */ + PMOD_EXPORT PIKEFUN int program_implements(program prog, program api) errname Program.implements; optflags OPT_TRY_OPTIMIZE; { RETURN implements(prog, api); } - //! Returns 1 if @[child] has inherited @[parent]. - //! - PIKEFUN int program_inherits(program child, program parent) + /*! @decl int inherits(program|object child, program parent) + *! @belongs Program + *! + *! Returns 1 if @[child] has inherited @[parent]. + */ + PMOD_EXPORT + PIKEFUN int program_inherits(program|object child, program parent) errname Program.inherits; optflags OPT_TRY_OPTIMIZE; { - RETURN !!low_get_storage(parent, child); + struct program *p = program_from_svalue(child); + + if (!p) + SIMPLE_ARG_TYPE_ERROR("Program.inherits", 1, "program|object"); + RETURN low_get_storage(p, parent) != -1; } - //! 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. - //! + /*! @decl string defined(program p) + *! @belongs Program + *! + *! Returns a string with filename and linenumber describing where + *! the program @[p] was defined. + *! + *! The returned string is of the format @expr{"filename:linenumber"@}. + *! + *! If it cannot be determined where the program was defined, @expr{0@} + *! (zero) will be returned. + */ + PMOD_EXPORT 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); + INT_TYPE line; + struct pike_string *tmp = low_get_program_line(p, &line); + pop_n_elems(args); - push_string(tmp2); - if(line > 1) + if (tmp) { + push_string(tmp); + if(line >= 1) { push_constant_text(":"); push_int(line); f_add(3); } - return; + } - } - - pop_n_elems(args); + else push_int(0); } - //! 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 string_width(string s) + /*! @decl int(8..8)|int(16..16)|int(32..32) width(string s) + *! @belongs String + *! + *! Returns the width of a string. + *! + *! @returns + *! Three return values are currently 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 + *! + *! @note + *! It is possible that a future version of Pike may return + *! further values. In particular the width @expr{7@} seems + *! like it could be useful. + */ + PMOD_EXPORT + 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); } - //! 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()] - //! - PIKEFUN 1 m_delete(mapping(mixed:1=mixed) map, mixed index) + /*! @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 its single argument. + *! + *! Otherwise 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()] + */ + PMOD_EXPORT + PIKEFUN mixed m_delete(object|mapping map, mixed index) efun; optflags OPT_SIDE_EFFECT; - + rawtype tOr(tFunc(tMap(tSetvar(0,tMix),tSetvar(1,tMix)) tVar(0),tVar(1)),tFunc(tObj tMix,tMix)) { - + struct program *p; + if( TYPEOF(*map) == T_MAPPING ) + { struct svalue s; - map_delete_no_free(map, index, &s); + map_delete_no_free(map->u.mapping, index, &s); pop_n_elems(args); - *sp=s; - sp++; + *Pike_sp=s; + Pike_sp++; + dmalloc_touch_svalue(Pike_sp-1); } - + else if (TYPEOF(*map) == T_OBJECT && (p = map->u.object->prog)) + { + int id = FIND_LFUN(p->inherits[SUBTYPEOF(*map)].prog, LFUN__M_DELETE); - //! Returns 1 if the weak flag has been set for @[m]. - //! - PIKEFUN int(0 .. 1) get_weak_flag(array|mapping|multiset m) + if( id == -1 ) + SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object containing the _m_delete method"); + + apply_low(map->u.object, + id + p->inherits[SUBTYPEOF(*map)].identifier_level, 1); + stack_swap(); + pop_stack(); + } else { + SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object|mapping"); + } + } + + /*! @decl int get_weak_flag(array|mapping|multiset m) + *! + *! Returns the weak flag settings for @[m]. It's a combination of + *! @[Pike.WEAK_INDICES] and @[Pike.WEAK_VALUES]. + */ + PMOD_EXPORT + PIKEFUN int get_weak_flag(array m) efun; optflags OPT_EXTERNAL_DEPEND; { - int flag = 0; - switch (m->type) { - case T_ARRAY: - flag = !!(m->u.array->flags & ARRAY_WEAK_FLAG); + RETURN (m->flags & ARRAY_WEAK_FLAG) ? PIKE_WEAK_VALUES : 0; + } + + PMOD_EXPORT + PIKEFUN int get_weak_flag(mapping m) + { + RETURN mapping_get_flags(m) & MAPPING_WEAK; + } + + PMOD_EXPORT + PIKEFUN int get_weak_flag(multiset m) + { + RETURN multiset_get_flags(m) & MULTISET_WEAK; + } + + /*! @decl program __empty_program(int|void line, string|void file) + */ + PIKEFUN program __empty_program(int|zero|void line, string|void file) + efun; + optflags OPT_EXTERNAL_DEPEND; + { + struct program *prog = low_allocate_program(); + if (file) ext_store_program_line (prog, line, file); + #if 0 + push_program (prog); + safe_pike_fprintf (stderr, "Creating empty program %O (%x)\n", + Pike_sp - 1, Pike_sp[-1].u.program); + Pike_sp--; + #endif + RETURN prog; + } + + /* Cut the string at the first NUL. */ + static struct pike_string *delambda(struct pike_string *str) + { + PCHARP pcharp = MKPCHARP_STR(str); + ptrdiff_t len = pcharp_strlen(pcharp); + if (len == str->len) { + /* Common case. */ + add_ref(str); + return str; + } + return make_shared_binary_pcharp(pcharp, len); + } + + /*! @decl string function_name(function f) + *! + *! Return the name of the function @[f]. + *! + *! If @[f] is a global function defined in the runtime @expr{0@} + *! (zero) will be returned. + *! + *! @seealso + *! @[function_object()] + */ + PMOD_EXPORT + PIKEFUN string function_name(program|function func) + efun; + optflags OPT_TRY_OPTIMIZE; + { + int f = -1; + struct program *p = NULL; + + switch(TYPEOF(*func)) + { + default: + SIMPLE_BAD_ARG_ERROR("function_name", 1, "function|program"); + return; /* NOTREACHED */ + + case PIKE_T_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) && + (id->func.const_info.offset >= 0) && + is_eq( & PROG_FROM_INT(p, e)->constants[id->func.const_info.offset].sval, + func)) + REF_RETURN id->name; + } + #ifdef PIKE_DEBUG + if (d_flag>5) { + fprintf(stderr, + "Failed to find symbol for program %p\n" + "Parent program info:\n", + func->u.program); + dump_program_tables(func->u.program->parent, 0); + } + #endif + } break; - case T_MAPPING: - flag = !!(mapping_get_flags(m->u.mapping) & MAPPING_FLAG_WEAK); + } + + case PIKE_T_FUNCTION: + if((f = SUBTYPEOF(*func)) == FUNCTION_BUILTIN) break; + if(!(p = func->u.object->prog)) + bad_arg_error("function_name", Pike_sp-args, args, 1, + "function", Pike_sp-args, + "Destructed object.\n"); + if(p == pike_trampoline_program) + { + struct pike_trampoline *t; + t=((struct pike_trampoline *)func->u.object->storage); + + if(t->frame->current_object->prog) { + p = t->frame->current_object->prog; + f = t->func; + } + } + + #ifdef PIKE_DEBUG + if(f >= p->num_identifier_references) + Pike_fatal("Function without reference.\n"); + #endif + RETURN delambda(ID_FROM_INT(p, f)->name); + } + pop_n_elems(args); + push_int(0); + } + + /*! @decl object function_object(function f) + *! + *! Return the object the function @[f] is in. + *! + *! If @[f] is a global function defined in the runtime @expr{0@} + *! (zero) will be returned. + *! + *! 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. + *! + *! @seealso + *! @[function_name()], @[function_program()] + */ + PMOD_EXPORT + PIKEFUN object function_object(function|program func) + efun; + optflags OPT_TRY_OPTIMIZE; + type function(function:object); + { + switch(TYPEOF(*func)) + { + case PIKE_T_PROGRAM: break; - case T_MULTISET: - flag = !!(m->u.multiset->ind->flags & (ARRAY_WEAK_FLAG|ARRAY_WEAK_SHRINK)); + + case PIKE_T_FUNCTION: + if(SUBTYPEOF(*func) == 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; + } + SET_SVAL(*func, T_OBJECT, 0, object, func->u.object); + return; + + + default: + SIMPLE_BAD_ARG_ERROR("function_object",1,"function"); + } + pop_n_elems(args); + push_int(0); + } + + /*! @decl program function_program(function|program f) + *! + *! Return the program the function @[f] is in. + *! + *! If @[f] is a global function defined in the runtime @expr{0@} + *! (zero) will be returned. + *! + *! @seealso + *! @[function_name()], @[function_object()] + */ + PMOD_EXPORT + PIKEFUN program function_program(program|function func) + efun; + optflags OPT_TRY_OPTIMIZE; + { + switch(TYPEOF(*func)) + { + 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(SUBTYPEOF(*func) == FUNCTION_BUILTIN) + p = func->u.efun->prog; + else + 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("get_weak_flag",1,"array|mapping|multiset"); + SIMPLE_BAD_ARG_ERROR("function_program", 1, "function"); } pop_n_elems(args); - push_int(flag); + push_int(0); } - + + /*! @decl mixed random(object o) + *! If random is called with an object, @[lfun::random] will be + *! called in the object. + *! @seealso + *! @[lfun::_random] + */ + + /*! @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()] + */ + + PMOD_EXPORT + PIKEFUN mixed random(object o) + efun; + optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND; + { + apply(o,"_random",0); + stack_swap(); + pop_stack(); + } + + /*! @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()] + */ + + PMOD_EXPORT + PIKEFUN int random(int i) + { + if(i <= 0) RETURN 0; + #if SIZEOF_INT_TYPE > 4 + if(i >> 31) { + unsigned INT_TYPE a = my_rand(); + unsigned INT_TYPE b = my_rand(); + RETURN (INT_TYPE)(((a<<32)|b) % i); + } + #endif + RETURN my_rand() % i; + } + + PMOD_EXPORT + PIKEFUN float random(float f) + { + if(f<=0.0) RETURN 0.0; + #define N 1048576 + RETURN f * (my_rand()%N/((float)N)) + + f * (my_rand()%N/( ((float)N) * ((float)N) )); + + } + + /*! @decl mixed random(array|multiset x) + *! Returns a random element from @[x]. + */ + + PMOD_EXPORT + PIKEFUN mixed random(array a) + rawtype tFunc(tArr(tSetvar(0,tMix)),tVar(0)); + { + 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(); + } + + PMOD_EXPORT + PIKEFUN mixed random(multiset m) + rawtype tFunc(tSet(tSetvar(1,tMix)),tVar(1)); + { + if(multiset_is_empty (m)) + SIMPLE_BAD_ARG_ERROR("random", 1, "multiset with elements in it"); + 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); + } + stack_swap(); + pop_stack(); + } + + /*! @decl array random(mapping m) + *! Returns a random index-value pair from the mapping. + */ + + PMOD_EXPORT + PIKEFUN array random(mapping m) + { + 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(); + } + + #if defined(HAVE_SETENV) && defined(HAVE_UNSETENV) + #define USE_SETENV + #else + /* Used to hold refs to the strings that we feed to putenv. Indexed on + * variable names, values are the "name=value" strings. + * + * This is not needed when using {,un}setenv(), since they maintain + * their own corresponding table. */ + static struct mapping *env_allocs = NULL; + #endif + + /* Works exactly like the getenv efun defined in the master, but only + * accesses the real environment. Everyone should use the caching + * version in the master instead. */ + PIKEFUN string|mapping _getenv (void|string var) + rawtype tOr(tFunc(tStr, tString), tFunc(tVoid, tMap (tStr, tStr))); + { + /* FIXME: Perhaps add the amigaos4 stuff from pike_push_env here too. */ + + if (var) { + if (var->size_shift) + SIMPLE_ARG_TYPE_ERROR ("getenv", 1, "void|string(0..255)"); + + if (string_has_null (var)) { + /* Won't find a variable name like this. */ + pop_stack(); + push_int (0); + } + + else { + char *entry = getenv (var->str); + pop_stack(); + if (!entry) + push_int (0); + else { + char *eq = STRCHR (entry, '='); + /* There should always be a '=' in the entry, but you never know.. */ + push_string (make_shared_string (eq ? eq + 1 : entry)); + } + } + } + + else { + #ifdef DECLARE_ENVIRON + extern char **environ; + #endif + struct mapping *m, *new_env_allocs; + int n; + + /* Iterate the environment backwards below so that earlier + * variables will override later ones in case the same variable + * occur multiple times (which it shouldn't). That makes the + * result similar to what getenv(3) commonly returns (at least the + * one in gnu libc). */ + for (n = 0; environ[n]; n++) {} + + m = allocate_mapping (n); + #ifndef USE_SETENV + if (env_allocs) + new_env_allocs = allocate_mapping (m_sizeof (env_allocs)); + #endif /* !USE_SETENV */ + + while (--n >= 0) { + char *entry = environ[n], *eq = STRCHR (entry, '='); + if (eq) { /* gnu libc getenv ignores variables without '='. */ + struct pike_string *var = make_shared_binary_string (entry, eq - entry); + struct pike_string *val = make_shared_string (eq + 1); + mapping_string_insert_string (m, var, val); + + #ifndef USE_SETENV + /* Populate new_env_allocs with the env_allocs entries that + * are still in use. */ + if (env_allocs) { + struct svalue *ea_val = low_mapping_string_lookup (env_allocs, var); + if (ea_val && ea_val->u.string->str == entry) + mapping_string_insert (new_env_allocs, var, ea_val); + } + #endif /* !USE_SETENV */ + + free_string (var); + free_string (val); + } + } + + #ifndef USE_SETENV + if (env_allocs) { + free_mapping (env_allocs); + env_allocs = new_env_allocs; + } + #endif /* !USE_SETENV */ + + push_mapping (m); + } + } + + /* Works exactly like the putenv efun defined in the master, but only + * updates the real environment. Everyone should use the version in + * the master instead so that the cache doesn't get stale. */ + PIKEFUN void _putenv (string var, void|string val) + { + #ifndef USE_SETENV + struct pike_string *putenv_str, *env_alloc_var; + #endif + + if (var->size_shift) + SIMPLE_ARG_TYPE_ERROR ("putenv", 1, "string(0..255)"); + if (string_has_null (var) || STRCHR (var->str, '=')) + SIMPLE_ARG_ERROR ("putenv", 1, "Variable name cannot contain '=' or NUL."); + + if (val) { + #ifndef USE_SETENV + struct string_builder sb; + #endif + + if (val->size_shift) + SIMPLE_ARG_TYPE_ERROR ("putenv", 2, "void|string(0..255)"); + if (string_has_null (val)) + SIMPLE_ARG_ERROR ("putenv", 2, "Variable value cannot contain NUL."); + + #ifdef USE_SETENV + if (setenv(var->str, val->str, 1)) { + if (errno == ENOMEM) + SIMPLE_OUT_OF_MEMORY_ERROR ("putenv", 0); + else + Pike_error ("Error from setenv(3): %s\n", strerror (errno)); + } + #else /* !USE_SETENV */ + init_string_builder (&sb, 0); + string_builder_shared_strcat (&sb, var); + string_builder_putchar (&sb, '='); + string_builder_shared_strcat (&sb, val); + putenv_str = finish_string_builder (&sb); + push_string (putenv_str); /* Let mega_apply pop. */ + #endif /* USE_SETENV */ + } + else { + #ifdef USE_SETENV + /* Note: Some versions of glibc have a unsetenv(3) that returns void, + * thus no checking of the return value here. + */ + unsetenv(var->str); + #else /* !USE_SETENV */ + #ifdef PUTENV_ALWAYS_REQUIRES_EQUAL + /* Windows can never get things quite right.. :P */ + struct string_builder sb; + init_string_builder (&sb, 0); + string_builder_shared_strcat (&sb, var); + string_builder_putchar (&sb, '='); + putenv_str = finish_string_builder (&sb); + push_string (putenv_str); /* Let mega_apply pop. */ + #else + putenv_str = var; + #endif + #endif /* USE_SETENV */ + } + + #ifndef USE_SETENV + if (putenv (putenv_str->str)) { + if (errno == ENOMEM) + SIMPLE_OUT_OF_MEMORY_ERROR ("putenv", 0); + else + Pike_error ("Error from putenv(3): %s\n", strerror (errno)); + } + + #ifdef __NT__ + ref_push_string (var); + f_lower_case (1); + assert (TYPEOF(Pike_sp[-1]) == T_STRING); + env_alloc_var = Pike_sp[-1].u.string; + /* Let mega_apply pop. */ + #else + env_alloc_var = var; + #endif + + if (!env_allocs) env_allocs = allocate_mapping (4); + + if (val) + /* Must keep the string passed to putenv allocated (and we + * assume no other entities are naughty enough to modify it). */ + mapping_string_insert_string (env_allocs, env_alloc_var, putenv_str); + else { + struct svalue key; + SET_SVAL(key, T_STRING, 0, string, env_alloc_var); + map_delete (env_allocs, &key); + } + #endif /* !USE_SETENV */ + } + + #if defined(PIKE_DEBUG) && defined(PIKE_PORTABLE_BYTECODE) + + /*! @decl void disassemble(function fun) + *! @belongs Debug + *! + *! Disassemble a Pike function to @[Stdio.stderr]. + *! + *! @note + *! This function is only available if the Pike runtime + *! has been compiled with debug enabled. + */ + PIKEFUN void _disassemble(function fun) + { + if ((TYPEOF(*fun) != T_FUNCTION) || + (SUBTYPEOF(*fun) == FUNCTION_BUILTIN)) { + fprintf(stderr, + "Disassembly only supported for functions implemented in Pike.\n"); + } else if (!fun->u.object->prog) { + fprintf(stderr, "Function in destructed object.\n"); + } else { + int f = SUBTYPEOF(*fun); + struct reference *ptr = PTR_FROM_INT(fun->u.object->prog, f); + struct program *p = PROG_FROM_PTR(fun->u.object->prog, ptr); + struct identifier *id = p->identifiers + ptr->identifier_offset; + if (id->func.offset >= 0) { + struct pike_string *tripples = + p->strings[read_program_data(p->program + id->func.offset, -1)]; + switch(tripples->size_shift) { + #define CASE(SHIFT) \ + case SHIFT: \ + { \ + PIKE_CONCAT(p_wchar, SHIFT) *str = \ + PIKE_CONCAT(STR, SHIFT)(tripples); \ + int i=0; \ + while(i < tripples->len) { \ + fprintf(stderr, "@@@ %d: %s, %d, %d\n", \ + i/3, \ + instrs[*str - F_OFFSET]. \ + name, \ + str[1], str[2]); \ + str += 3; \ + i += 3; \ + } \ + } \ + break + CASE(0); + CASE(1); + CASE(2); + #undef CASE + } + } else { + fprintf(stderr, "Prototype.\n"); + } + } + pop_n_elems(args); + push_int(0); + } + + #endif /* PIKE_DEBUG && PIKE_PORTABLE_BYTECODE */ + + /* + * Backtrace handling. + */ + + /*! @module Pike + */ + + /*! @class BacktraceFrame + */ + + PIKECLASS backtrace_frame + { + PIKEVAR mixed _fun flags ID_PROTECTED|ID_PRIVATE; + #ifdef PIKE_DEBUG + PIKEVAR program oprog flags ID_PROTECTED|ID_PRIVATE; + #endif + PIKEVAR array args; + + /* These are cleared when filename and lineno have been initialized + * from them. */ + PIKEVAR program prog flags ID_PROTECTED|ID_PRIVATE; + CVAR PIKE_OPCODE_T *pc; + + /* These two are considered to be uninitialized from prog, pc and + * fun as long as lineno == -1. */ + CVAR struct pike_string *filename; + CVAR INT_TYPE lineno; + + INIT + { + THIS->pc = NULL; + THIS->lineno = -1; + THIS->filename = NULL; + } + + EXIT + gc_trivial; + { + if (THIS->filename) { + free_string(THIS->filename); + THIS->filename = NULL; + } + THIS->pc = NULL; + THIS->lineno = -1; + } + + /* NOTE: Use old-style getter/setter syntax for compatibility with + * old Parser.Pike.split() used by precompile.pike. + */ + + PIKEFUN mixed `->fun() + { + push_svalue(&THIS->_fun); + } + + PIKEFUN void `->fun=(mixed val) + { + /* FIXME: Should we allow this at all? + * Linenumber info etc won't match. + */ + #ifdef PIKE_DEBUG + if ((TYPEOF(*val) == T_FUNCTION) && (SUBTYPEOF(*val) != FUNCTION_BUILTIN)) { + assign_short_svalue((union anything *)&THIS->oprog, + (union anything *)&val->u.object->prog, T_PROGRAM); + } + #endif + assign_svalue(&THIS->_fun, val); + } + + /*! @decl int(0..1) _is_type(string t) + *! This object claims to be an array for backward compatibility. + */ + PIKEFUN int(0..1) _is_type(string t) + { + INT_TYPE res = (t == findstring("array")); + pop_n_elems(args); + push_int(res); + } + + static void fill_in_file_and_line() + { + struct pike_string *file = NULL; + assert (THIS->lineno == -1); + + if (THIS->pc && THIS->prog) { + file = low_get_line(THIS->pc, THIS->prog, &THIS->lineno); + THIS->pc = NULL; + } + else if (TYPEOF(THIS->_fun) == PIKE_T_FUNCTION) { + #ifdef PIKE_DEBUG + if (THIS->_fun.u.object->prog && + THIS->_fun.u.object->prog != THIS->oprog) { + struct identifier *id = ID_FROM_INT(THIS->oprog, SUBTYPEOF(THIS->_fun)); + /* FIXME: Dump dmalloc info for the object? */ + Pike_fatal("Lost track of function pointer! Function name was %s.\n", + id->name?id->name->str:"<no name>"); + } + #endif + file = low_get_function_line (THIS->_fun.u.object, SUBTYPEOF(THIS->_fun), + &THIS->lineno); + } + else if (THIS->prog) { + file = low_get_program_line (THIS->prog, &THIS->lineno); + } + + if (file) { + if (!THIS->filename) THIS->filename = file; + else free_string (file); + } + + if (THIS->prog) { + free_program(THIS->prog); + THIS->prog = NULL; + } + } + + /*! @decl string _sprintf(int c, mapping|void opts) + */ + PIKEFUN string _sprintf(int c, mapping|void opts) + { + pop_n_elems(args); + + if (c != 'O') { + push_undefined (); + return; + } + + push_text("backtrace_frame("); + + if (THIS->lineno == -1) fill_in_file_and_line(); + + if (THIS->filename) { + ref_push_string(THIS->filename); + push_text(":"); + push_int(THIS->lineno); + push_text(", "); + f_add(4); + } else { + push_text("Unknown file, "); + } + if (TYPEOF(THIS->_fun) == PIKE_T_FUNCTION) { + if (THIS->_fun.u.object->prog) { + #ifdef PIKE_DEBUG + if (THIS->_fun.u.object->prog != THIS->oprog) { + struct identifier *id = + ID_FROM_INT(THIS->oprog, SUBTYPEOF(THIS->_fun)); + /* FIXME: Dump dmalloc info for the object? */ + Pike_fatal("Lost track of function pointer! Function name was %s.\n", + id->name?id->name->str:"<no name>"); + } + #endif + push_svalue(&THIS->_fun); + f_function_name(1); + push_text("(), "); + f_add(2); + } else { + free_svalue(&THIS->_fun); + SET_SVAL(THIS->_fun, PIKE_T_INT, NUMBER_DESTRUCTED, integer, 0); + push_text("destructed_function(), "); + } + } else if (TYPEOF(THIS->_fun) == PIKE_T_PROGRAM) { + /* FIXME: Use the master? */ + push_text("program(), "); + } else if (TYPEOF(THIS->_fun) == PIKE_T_STRING) { + push_svalue(&THIS->_fun); + push_text("(), "); + f_add(2); + } else { + push_text("destructed_function(), "); + } + + if (THIS->args) { + push_text("Args: "); + push_int(THIS->args->size); + f_add(2); + } else { + push_text("No args"); + } + push_text(")"); + f_add(5); + } + + /*! @decl int(3..) _sizeof() + */ + PIKEFUN int(3..) _sizeof() + { + if (THIS->args) { + push_int(THIS->args->size + 3); + } else { + push_int(3); + } + } + + /*! @decl mixed `[](int index, int|void end_or_none) + *! The BacktraceFrame object can be indexed as an array. + */ + PIKEFUN mixed `[](int index, int|void end_or_none) + { + INT_TYPE end = index; + INT32 numargs = 0; + INT32 i; + + if (THIS->args) { + numargs = THIS->args->size; + } + + 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 (TYPEOF(*end_or_none) != PIKE_T_INT) { + SIMPLE_BAD_ARG_ERROR("`[]",2,"int|void"); + } + end = end_or_none->u.integer; + } + + pop_n_elems(args); + + if (end_or_none) { + if ((end < 0) || (end < index) || (index >= numargs)) { + f_aggregate(0); + return; + } + + if (end >= numargs) { + end = numargs-1; + } + } + + for (i = index; i <= end; i++) { + switch(i) { + case 0: /* Filename */ + if (THIS->lineno == -1) fill_in_file_and_line(); + if (THIS->filename) { + ref_push_string(THIS->filename); + } else { + push_int(0); + } + break; + case 1: /* Linenumber */ + if (THIS->lineno == -1) fill_in_file_and_line(); + push_int(THIS->lineno); + break; + case 2: /* Function */ + push_svalue(&THIS->_fun); + break; + default: /* Arguments */ + { + if ((i > 2) && (THIS->args) && (i-3 < THIS->args->size)) { + push_svalue(THIS->args->item + (i - 3)); + 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; + } + } + if (end_or_none) { + f_aggregate(1 + end - index); + } + } + + /*! @decl mixed `[]=(int index, mixed value) + */ + 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 */ + if (THIS->lineno == -1) fill_in_file_and_line(); + if (TYPEOF(*value) != PIKE_T_STRING) { + if ((TYPEOF(*value) != PIKE_T_INT) || + (value->u.integer)) { + SIMPLE_BAD_ARG_ERROR("backtrace_frame->`[]=", 2, + "string|int(0..0)"); + } + if (THIS->filename) { + free_string(THIS->filename); + THIS->filename = NULL; + } + } else { + if (THIS->filename) { + free_string(THIS->filename); + THIS->filename = NULL; + } + copy_shared_string(THIS->filename, value->u.string); + } + break; + + case 1: /* Linenumber */ + if (THIS->lineno == -1) fill_in_file_and_line(); + if (TYPEOF(*value) != PIKE_T_INT) { + SIMPLE_BAD_ARG_ERROR("backtrace_frame->`[]=", 2, "int(1..)"); + } + THIS->lineno = value->u.integer; + break; + + case 2: /* Function */ + if (THIS->lineno == -1) fill_in_file_and_line(); + assign_svalue(&THIS->_fun, value); + break; + default: /* Arguments */ + assign_svalue(THIS->args->item + index - 3, value); + break; + } + stack_swap(); + pop_stack(); + } + + }; + + /*! @endclass + */ + + /*! @decl mapping(string:int|string) get_runtime_info() + *! + *! Get information about the Pike runtime. + *! + *! @returns + *! Returns a mapping with the following content: + *! @mapping + *! @member string "bytecode_method" + *! A string describing the bytecode method used by + *! the Pike interpreter. + *! @member int "abi" + *! The number of bits in the ABI. Usually @expr{32@} or @expr{64@}. + *! @member int "native_byteorder" + *! The byte order used by the native cpu. + *! Usually @expr{1234@} (aka little endian) or + *! @expr{4321@} (aka bigendian). + *! @member int "int_size" + *! The number of bits in the native integer type. + *! Usually @expr{32@} or @expr{64@}. + *! @member int "float_size" + *! The number of bits in the native floating point type. + *! Usually @expr{32@} or @expr{64@}. + *! @member int(0..1) "auto_bignum" + *! Present if integers larger than the native size are automatically + *! converted into bignums. + *! @endmapping + */ + PIKEFUN mapping(string:int|string) get_runtime_info() + optflags OPT_TRY_OPTIMIZE; + { + pop_n_elems(args); + push_constant_text("bytecode_method"); + push_constant_text(PIKE_BYTECODE_METHOD_NAME); + push_constant_text("abi"); + push_int(sizeof(void *) * 8); + push_constant_text("native_byteorder"); + push_int(PIKE_BYTEORDER); + push_constant_text("int_size"); + push_int(sizeof(INT_TYPE) * 8); + push_constant_text("float_size"); + push_int(sizeof(FLOAT_TYPE) * 8); + push_constant_text("auto_bignum"); + push_int(1); + f_aggregate_mapping(6*2); + } + + /*! @endmodule + */ + + void low_backtrace(struct Pike_interpreter_struct *i) + { + struct svalue *stack_top = i->stack_pointer; + struct pike_frame *f, *of = 0; + int size = 0; + struct array *res = NULL; + + for (f = i->frame_pointer; f; f = f->next) { + size++; + } + + res = allocate_array_no_init(size, 0); + push_array(res); + + for (f = i->frame_pointer; f && size; f = (of = f)->next) { + struct object *o = low_clone(backtrace_frame_program); + struct backtrace_frame_struct *bf; + struct identifier *function = NULL; + + call_c_initializers(o); + + size--; + + SET_SVAL(res->item[size], PIKE_T_OBJECT, 0, object, o); + + bf = OBJ2_BACKTRACE_FRAME(o); + + if ((bf->prog = f->context->prog)) { + add_ref(bf->prog); + bf->pc = f->pc; + } + + SET_SVAL(bf->_fun, PIKE_T_INT, NUMBER_DESTRUCTED, integer, 0); + + if (f->current_object && f->current_object->prog) { + if (f->fun == FUNCTION_BUILTIN) { + /* Unusual case. The frame is from call_c_initializers(), gc() + * or similar. cf [bug 6156]. /grubba + * + * Masquerade as the program. + * + * FIXME: Ought to keep parent-pointers. + */ + SET_SVAL(bf->_fun, PIKE_T_PROGRAM, 0, + program, f->current_object->prog); + add_ref(f->current_object->prog); + } else { + SET_SVAL(bf->_fun, PIKE_T_FUNCTION, + CHECK_IDREF_RANGE(f->fun, f->current_object->prog), + object, f->current_object); + add_ref(f->current_object); + function = ID_FROM_INT(f->current_object->prog, f->fun); + #ifdef PIKE_DEBUG + add_ref(bf->oprog = bf->_fun.u.object->prog); + #endif + } + } + + if (f->locals) { + INT32 numargs = DO_NOT_WARN((INT32) MINIMUM(f->num_args, + stack_top - f->locals)); + INT32 varargs = 0; + + if(of && of->locals) { + /* f->num_args can be too large, so this is necessary for some + * reason. I don't know why. /mast + * + * possibly because f->num_args was uninitialized for c_initializers + * /arne + * */ + + numargs = DO_NOT_WARN((INT32)MINIMUM(f->num_args,of->locals - f->locals)); + } + + numargs = MAXIMUM(numargs, 0); + + /* Handle varargs... */ + if (function && (function->identifier_flags & IDENTIFIER_VARARGS) && + (f->locals + numargs < stack_top) && + (TYPEOF(f->locals[numargs]) == T_ARRAY)) { + varargs = f->locals[numargs].u.array->size; + } + + if (numargs + varargs) { + bf->args = allocate_array_no_init(numargs + varargs, 0); + bf->args->type_field = + assign_svalues_no_free(bf->args->item, f->locals, numargs, BIT_MIXED); + if (varargs) { + bf->args->type_field |= + assign_svalues_no_free(bf->args->item + numargs, + f->locals[numargs].u.array->item, + varargs, BIT_MIXED); + } + } + } + } + res->type_field = BIT_OBJECT; + /* NOTE: res has already been pushed on the stack. */ + } + + /*! @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 + *! (than 7.1) of Pike to accommodate for deferred backtraces. + *! + *! 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); + } + + /*! @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: + *! + *! @code + *! String.Buffer b = String.Buffer( ); + *! + *! function add = b->add; + *! + *! .. call add several times in code ... + *! + *! string result = b->get(); // also clears the buffer + *! @endcode + */ + PIKECLASS 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 ); + + /*! @decl void create(int initial_size) + *! + *! Initializes a new buffer. + *! + *! If no @[initial_size] is specified, 256 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. + */ + PIKEFUN void create( int|void size ) + { + struct Buffer_struct *str = THIS; + if( size ) + str->initial = MAXIMUM( size->u.integer, 512 ); + else + str->initial = 256; + } + + /*! @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. + */ + 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 ); + dmalloc_touch_svalue(Pike_sp-1); + 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_undefined(); + } + + /*! @decl mixed cast( string type ) + *! It is possible to cast a String.Buffer object to + *! a @expr{string@} and an @expr{int@}. + */ + PIKEFUN mixed cast( string type ) + { + struct pike_string *string_t; + struct pike_string *int_t; + MAKE_CONST_STRING( string_t, "string" ); + MAKE_CONST_STRING( int_t, "int" ); + + 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); + } + + /*! @decl String.Buffer `+( string what ) + */ + PIKEFUN object `+( string what ) + { + struct Buffer_struct *str = THIS, *str2; + struct object *res = fast_clone_object( Buffer_program ); + str2 = OBJ2_BUFFER( res ); + str2->initial = str->initial; + if( str->str.s ) + init_string_builder_copy (&str2->str, &str->str); + apply( res, "add", 1 ); + RETURN res; + } + + /*! @decl String.Buffer `+=( string what ) + */ + PIKEFUN object `+=( string what ) + { + f_Buffer_add( 1 ); + REF_RETURN Pike_fp->current_object; + } + + /*! @decl int add(string ... data) + *! + *! Adds @[data] to the buffer. + *! + *! @returns + *! Returns the size of the buffer. + *! + *! @seealso + *! @[addat()] + */ + PIKEFUN int add( string ... arg1 ) + { + struct Buffer_struct *str = THIS; + int init_from_arg0 = 0, j; + + if (!str->str.s && args) { + ptrdiff_t 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; + else if (sum > str->initial) + sum <<= 1; + shift = shift & ~(shift >> 1); + + if (shift == Pike_sp[-args].u.string->size_shift && + init_string_builder_with_string (&str->str, Pike_sp[-args].u.string)) { + mark_free_svalue (Pike_sp - args); + if (sum > str->str.s->len) + string_build_mkspace (&str->str, sum - str->str.s->len, shift); + init_from_arg0 = 1; + } + else + 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; + } + + for( j = init_from_arg0; j<args; j++ ) + { + struct pike_string *a = Pike_sp[j-args].u.string; + string_builder_shared_strcat( &str->str, a ); + } + + if (str->str.s) { + RETURN str->str.s->len; + } else { + RETURN 0; + } + } + + /*! @decl int addat(int(0..) pos, string ... data) + *! + *! Adds @[data] to the buffer, starting at position @[pos]. + *! + *! @returns + *! Returns the size of the buffer. + *! + *! @note + *! If the buffer isn't of the required size, it is padded + *! with NUL-characters. + *! + *! @seealso + *! @[add()] + */ + PIKEFUN int addat(int(0..) pos, string ... arg1 ) + { + struct Buffer_struct *str = THIS; + + if (pos < 0) + SIMPLE_BAD_ARG_ERROR("addat", 1, "int(0..)"); + + if (args) { + int init_from_arg0 = 0, j; + ptrdiff_t sum = 0; + int shift = 0; + for (j=1; j < args; j++) { + struct pike_string *a = Pike_sp[j-args].u.string; + sum += a->len; + shift |= a->size_shift; + } + + if (!str->str.s) { + if ((sum + pos) <= str->initial) { + sum = str->initial; + } else { + sum <<= 1; + sum += pos; + } + shift = shift & ~(shift >> 1); + + init_string_builder_alloc(&str->str, sum, shift); + } else { + sum += pos; + shift |= str->str.known_shift; + shift = shift & ~(shift >> 1); + if (sum > str->str.s->len) { + string_build_mkspace(&str->str, sum - str->str.s->len, shift); + } else if (shift != str->str.known_shift) { + string_build_mkspace(&str->str, 0, shift); + } + } + /* We know it will be a string that really is this wide. */ + str->str.known_shift = shift; + + if (str->str.s->len < pos) { + /* Clear the padding. */ + MEMSET(str->str.s->str + (str->str.s->len << str->str.s->size_shift), + 0, (pos - str->str.s->len) << str->str.s->size_shift); + } + + for(j = 1; j<args; j++) { + struct pike_string *a = Pike_sp[j-args].u.string; + pike_string_cpy(MKPCHARP_STR_OFF(str->str.s, pos), a); + pos += a->len; + } + + if (str->str.s->len < pos) { + str->str.s->len = pos; + /* Ensure NUL-termination */ + str->str.s->str[str->str.s->len << str->str.s->size_shift] = 0; + } + } + + if (str->str.s) { + RETURN str->str.s->len; + } else { + RETURN 0; + } + } + + /*! @decl void putchar(int c) + *! Appends the character @[c] at the end of the string. + */ + PIKEFUN void putchar(int c) { + struct Buffer_struct *str = THIS; + if(!str->str.s) + init_string_builder_alloc(&str->str, str->initial, 0); + string_builder_putchar(&str->str, c); + } + + /*! @decl int sprintf(strict_sprintf_format format, sprintf_args ... args) + *! Appends the output from @[sprintf] at the end of the string. + *! Returns the resulting size of the String.Buffer. + */ + PIKEFUN int sprintf(mixed ... arguments) + rawtype tFuncV(tAttr("strict_sprintf_format", tOr(tStr, tObj)), + tAttr("sprintf_args", tMix), tStr); + + { + // FIXME: Reset length on exception? + struct Buffer_struct *str = THIS; + if(!str->str.s) + init_string_builder_alloc(&str->str, str->initial, 0); + low_f_sprintf(args, 0, &str->str); + RETURN str->str.s->len; + } + + /*! @decl string get_copy() + *! + *! Get the data from the buffer. Significantly slower than @[get], + *! but does not clear the buffer. + */ + PIKEFUN string get_copy() + { + 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_string0((p_wchar0 *)d,len); + break; + case 1: + RETURN make_shared_binary_string1((p_wchar1 *)d,len); + break; + case 2: + RETURN make_shared_binary_string2((p_wchar2 *)d,len); + break; + } + } + } + push_empty_string(); + return; + } + + /*! @decl string get() + *! + *! Get the data from the buffer. + *! + *! @note + *! This will clear the data in the buffer + */ + PIKEFUN string get( ) + { + struct Buffer_struct *str = THIS; + if( str->str.s ) + { + struct pike_string *s = finish_string_builder( &str->str ); + str->str.malloced = 0; + str->str.s = NULL; + RETURN s; + } + pop_n_elems(args); + push_empty_string(); + return; + } + + /*! @decl int _sizeof() + *! + *! Returns the size of the buffer. + */ + PIKEFUN int _sizeof() + { + struct Buffer_struct *str = THIS; + RETURN str->str.s ? str->str.s->len : 0; + } + + INIT + { + struct Buffer_struct *str = THIS; + MEMSET( str, 0, sizeof( *str ) ); + } + + EXIT + gc_trivial; + { + struct Buffer_struct *str = THIS; + if( str->str.s ) + free_string_builder( &str->str ); + } + + GC_RECURSE + { + if (mc_count_bytes (Pike_fp->current_object) && THIS->str.s) + mc_counted_bytes += THIS->str.malloced; + } + } + + /*! @endclass + */ + + /*! @class Replace + *! + *! This is a "compiled" version of the @[replace] function applied on + *! a string, with more than one replace string. The replace strings + *! are given to the create method as a @i{from@} and @i{to@} array + *! and are then analyzed. The @expr{`()@} is then called with a + *! string and the replace rules in the Replace object will be + *! applied. The Replace object is used internally by the Pike + *! optimizer and need not be used manually. + */ + PIKECLASS multi_string_replace + { + CVAR struct replace_many_context ctx; + /* NOTE: from and to are only kept for _encode()'s use. */ + PIKEVAR array from flags ID_PROTECTED; + PIKEVAR array to flags ID_PROTECTED; + + /*! @decl void create(array(string)|mapping(string:string)|void from, @ + *! array(string)|string|void to) + */ + PIKEFUN void create(array(string)|mapping(string:string)|void from_arg, + array(string)|string|void to_arg) + { + if (THIS->from) { + free_array(THIS->from); + THIS->from = NULL; + } + if (THIS->to) { + free_array(THIS->to); + THIS->to = NULL; + } + if (THIS->ctx.v) + free_replace_many_context(&THIS->ctx); + + if (!args) { + push_int(0); + return; + } + if (from_arg && TYPEOF(*from_arg) == T_MAPPING) { + if (to_arg) { + Pike_error("Bad number of arguments to create().\n"); + } + THIS->from = mapping_indices(from_arg->u.mapping); + THIS->to = mapping_values(from_arg->u.mapping); + pop_n_elems(args); + args = 0; + } else { + /* FIXME: Why is from declared |void, when it isn't allowed + * to be void? + * /grubba 2004-09-02 + * + * It probably has to do with the "if (!args)" above: It should + * be possible to create an empty instance. /mast + */ + if (!from_arg || !to_arg) { + Pike_error("Bad number of arguments to create().\n"); + } + pop_n_elems(args-2); + args = 2; + if (TYPEOF(*from_arg) != T_ARRAY) { + SIMPLE_BAD_ARG_ERROR("Replace", 1, + "array(string)|mapping(string:string)"); + } + if (TYPEOF(*to_arg) == T_STRING) { + push_int(from_arg->u.array->size); + stack_swap(); + f_allocate(2); + } + if (TYPEOF(*to_arg) != T_ARRAY) { + SIMPLE_BAD_ARG_ERROR("Replace", 2, "array(string)|string"); + } + if (from_arg->u.array->size != to_arg->u.array->size) { + Pike_error("Replace must have equal-sized from and to arrays.\n"); + } + add_ref(THIS->from = from_arg->u.array); + add_ref(THIS->to = to_arg->u.array); + } + + if (!THIS->from->size) { + /* Enter no-op mode. */ + pop_n_elems(args); + push_int(0); + return; + } + + if( (THIS->from->type_field & ~BIT_STRING) && + (array_fix_type_field(THIS->from) & ~BIT_STRING) ) + SIMPLE_BAD_ARG_ERROR("Replace", 1, + "array(string)|mapping(string:string)"); + + if( (THIS->to->type_field & ~BIT_STRING) && + (array_fix_type_field(THIS->to) & ~BIT_STRING) ) + SIMPLE_BAD_ARG_ERROR("Replace", 2, "array(string)|string"); + + compile_replace_many(&THIS->ctx, THIS->from, THIS->to, 1); + + pop_n_elems(args); + push_int(0); + } + + /*! @decl string `()(string str) + */ + PIKEFUN string `()(string str) + { + if (!THIS->ctx.v) { + /* The result is already on the stack in the correct place... */ + return; + } + + RETURN execute_replace_many(&THIS->ctx, str); + } + + /*! @decl array(array(string)) _encode() + */ + PIKEFUN array(array(string)) _encode() + { + if (THIS->from) { + ref_push_array(THIS->from); + } else { + push_undefined(); + } + if (THIS->to) { + ref_push_array(THIS->to); + } else { + push_undefined(); + } + f_aggregate(2); + } + + /*! @decl void _decode(array(array(string)) encoded) + */ + 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); + } + + INIT + { + MEMSET(&THIS->ctx, 0, sizeof(struct replace_many_context)); + } + + EXIT + gc_trivial; + { + free_replace_many_context(&THIS->ctx); + } + } + + /*! @endclass + */ + + /*! @class SingleReplace + *! + *! This is a "compiled" version of the @[replace] function applied on + *! a string, with just one replace string. The replace strings are + *! given to the create method as a @i{from@} and @i{tom@} string and + *! are then analyzed. The @expr{`()@} is then called with a string + *! and the replace rule in the Replace object will be applied. The + *! Replace object is used internally by the Pike optimizer and need + *! not be used manually. + */ + PIKECLASS single_string_replace + { + CVAR SearchMojt mojt; + PIKEVAR string del flags ID_PROTECTED|ID_PRIVATE; + PIKEVAR string to flags ID_PROTECTED|ID_PRIVATE; + + EXTRA + { + MAP_VARIABLE ("o", tObj, ID_PROTECTED|ID_PRIVATE, + single_string_replace_storage_offset + + OFFSETOF (single_string_replace_struct, mojt.container), + T_OBJECT); + } + + /*! @decl void create(string|void from, string|void to) + *! + *! @note + *! May be called with either zero or two arguments. + */ + PIKEFUN void create(string|void del, string|void to) + { + if (THIS->del) { + free_string(THIS->del); + THIS->del = NULL; + } + if (THIS->to) { + free_string(THIS->to); + THIS->to = NULL; + } + + if (!del) return; + + if (!to) { + SIMPLE_BAD_ARG_ERROR("String.SingleReplace->create", 2, "string"); + } + + if (del == to) { + /* No-op... */ + return; + } + + copy_shared_string(THIS->del, del); + copy_shared_string(THIS->to, to); + + if (del->len) { + THIS->mojt = simple_compile_memsearcher(del); + } + } + + /*** replace function ***/ + typedef char *(* replace_searchfunc)(void *,void *,size_t); + + /*! @decl string `()(string str) + */ + 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 + default: Pike_fatal("Illegal shift.\n"); + #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) + Pike_fatal("SearchMojt found a match beyond end of string!\n"); + #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); + } + + /*! @decl array(string) _encode() + */ + PIKEFUN array(string) _encode() + { + if (THIS->del) { + ref_push_string(THIS->del); + ref_push_string(THIS->to); + f_aggregate(2); + } else { + push_int(0); + } + } + + /*! @decl void _decode(array(string)|int(0..0) encoded) + */ + PIKEFUN void _decode(array(string)|int(0..0) encoded_) + { + INT32 i = 0; + if (TYPEOF(*encoded_) == 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); + } + } + + /*! @endclass + */ + + /*! @class Bootstring + *! + *! This class implements the "Bootstring" string transcoder described in + *! @url{ftp://ftp.rfc-editor.org/in-notes/rfc3492.txt@}. + */ + PIKECLASS bootstring + { + CVAR INT_TYPE base, tmin, tmax, skew, damp; + CVAR INT_TYPE initial_bias, initial_n; + CVAR p_wchar2 delim; + PIKEVAR string digits flags ID_PROTECTED|ID_PRIVATE; + + 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); + } + + /*! @decl string decode(string s) + *! + *! Decodes a Bootstring encoded string of "basic" code points back + *! to the original string space. + */ + 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] = DO_NOT_WARN ((p_wchar0) 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] = DO_NOT_WARN ((p_wchar1) 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] = DO_NOT_WARN ((p_wchar2) n); + } + break; + #ifdef PIKE_DEBUG + default: + Pike_fatal("Illegal shift size!\n"); + #endif + } + i++; + } + + RETURN finish_string_builder( &output ); + } + + /*! @decl string encode(string s) + *! + *! Encodes a string using Bootstring encoding into a string constisting + *! only of "basic" code points (< initial_n). + */ + 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 ); + } + + /*! @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 + *! The damping factor for the bias adaption. Must be >= 2. + *! @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. + */ + PIKEFUN void create( int base, int tmin, int tmax, + int skew, int damp, + int initial_bias, int initial_n, + int delim, string digits ) + flags ID_PROTECTED; + { + struct bootstring_struct *bs = THIS; + 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"); + 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 ); + } + + } + + /*! @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()]) + *! + *! @note + *! Please note that these variables will continually update when + *! they are requested, there is no need to create new Time() + *! objects. + */ + + PIKEFUN int `sec() + { + struct timeval now; + + if( THIS->hard_update ) + ACCURATE_GETTIMEOFDAY( &now ); + else + INACCURATE_GETTIMEOFDAY( &now ); + + RETURN now.tv_sec; + } + + PIKEFUN int `usec() + { + struct timeval now; + + if( THIS->hard_update ) + ACCURATE_GETTIMEOFDAY( &now ); + else + INACCURATE_GETTIMEOFDAY( &now ); + + RETURN now.tv_usec; + } + + /*! @decl int usec_full + *! + *! The number of microseconds since the epoch. Please note that + *! pike needs to have been compiled with bignum support for this + *! variable to contain sensible values. + */ + + PIKEFUN int `usec_full() + { + struct timeval now; + + if( THIS->hard_update ) + ACCURATE_GETTIMEOFDAY( &now ); + else + INACCURATE_GETTIMEOFDAY( &now ); + + push_int( now.tv_sec ); + push_int( 1000000 ); + f_multiply( 2 ); + push_int( now.tv_usec ); + f_add( 2 ); + return; + } + + /*! @decl protected 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|zero|void fast ) + flags ID_PROTECTED; + { + 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( ) + { + struct timeval now; + FLOAT_TYPE res; + if( THIS->hard_update ) + ACCURATE_GETTIMEOFDAY( &now ); + else + INACCURATE_GETTIMEOFDAY( &now ); + res = now.tv_sec-THIS->last_time.tv_sec + + (now.tv_usec-THIS->last_time.tv_usec)/(FLOAT_TYPE) 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( ) + { + f_Timer_peek( 0 ); + INACCURATE_GETTIMEOFDAY(&THIS->last_time); + return; + } + + /*! @decl protected 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 more or less inexact timekeeping. + *! The pike maintained time is only updated when a @[Pike.Backend] + *! object stops waiting and starts executing code. + */ + PIKEFUN void create( int|zero|void fast ) + flags ID_PROTECTED; + { + THIS->hard_update = !fast; + if( THIS->hard_update ) + ACCURATE_GETTIMEOFDAY( &THIS->last_time ); + else + INACCURATE_GETTIMEOFDAY( &THIS->last_time ); + } + } + + /*! @endclass + */ + + /*! @endmodule + */ + + + 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); + if (mode != 'O') { + push_undefined (); + return; + } + 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; + TYPE_FIELD types; + + for(e=0;e<args;e++) + { + if(TYPEOF(real_args[e]) == T_OBJECT && + real_args[e].u.object->prog == automap_marker_program && + OBJ2_AUTOMAP_MARKER(real_args[e].u.object)->depth >= d) + { + if(TYPEOF(tmpargs[e]) != T_ARRAY) + index_error("__automap__", + Pike_sp-args, + args, + tmpargs, + NULL, + "Automap on non-array.\n"); + tmp=tmpargs[e].u.array->size; + if(tmp < size) + size=tmp; + } + } + + #ifdef PIKE_DEBUG + if(size == 0x7fffffff) + Pike_fatal("No automap markers found in low_automap\n"); + #endif + + push_array(ret=allocate_array(size)); + types = 0; + + for(x=0;x<size;x++) + { + for(e=0;e<args;e++) + { + if(TYPEOF(real_args[e]) == 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) + Pike_fatal("low_automap failed to determine size!\n"); + #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); + stack_pop_to_no_free (ITEM(ret) + x); + types |= 1 << TYPEOF(ITEM(ret)[x]); + } + ret->type_field = types; + 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(TYPEOF(tmpargs[e]) == 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); + } + + /* Linked list stuff. + */ + static struct block_allocator pike_list_node_allocator = BA_INIT_PAGES(sizeof(struct pike_list_node), 4); + + ATTRIBUTE((malloc)) + static struct pike_list_node * alloc_pike_list_node() { + struct pike_list_node * node = ba_alloc(&pike_list_node_allocator); + node->next = node->prev = NULL; + node->refs = 1; + SET_SVAL(node->val, T_INT, NUMBER_UNDEFINED, integer, 0); + return node; + } + + void count_memory_in_pike_list_nodes(size_t * n, size_t * s) { + ba_count_all(&pike_list_node_allocator, n, s); + } + + void free_all_pike_list_node_blocks() { + ba_destroy(&pike_list_node_allocator); + } + + PMOD_EXPORT void free_list_node(struct pike_list_node *node) + { + if (!sub_ref(node)) { + if (node->prev) { + free_list_node(node->prev); + } + if (node->next) { + free_list_node(node->next); + } + free_svalue(&node->val); + ba_free(&pike_list_node_allocator, node); + } + } + + PMOD_EXPORT void unlink_list_node(struct pike_list_node *n) + { + #ifdef PIKE_DEBUG + if (!n) { + Pike_fatal("Unlinking NULL node.\n"); + } + if (!n->next || !n->prev) { + Pike_fatal("Unlinking unlinked node.\n"); + } + #endif /* PIKE_DEBUG */ + if (n->prev->next == n) { + #ifdef PIKE_DEBUG + if (n->next->prev != n) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + n->prev->next = n->next; + n->next->prev = n->prev; + n->next = n->prev = NULL; + + /* We've lost two references. */ + free_list_node(n); + free_list_node(n); + } else { + #ifdef PIKE_DEBUG + if (n->next->prev == n) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + /* The node is already detached. */ + n->next = n->prev = NULL; + } + } + + PMOD_EXPORT void detach_list_node(struct pike_list_node *n) + { + #ifdef PIKE_DEBUG + if (!n) { + Pike_fatal("Detaching NULL node.\n"); + } + if (!n->next || !n->prev) { + Pike_fatal("Detaching unlinked node.\n"); + } + #endif /* PIKE_DEBUG */ + if (n->prev->next == n) { + #ifdef PIKE_DEBUG + if (n->next->prev != n) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + n->prev->next = n->next; + n->next->prev = n->prev; + add_ref(n->next); + add_ref(n->prev); + + /* We've lost two references. */ + free_list_node(n); + free_list_node(n); + #ifdef PIKE_DEBUG + } else if (n->next->prev == n) { + Pike_fatal("Partially detached node.\n"); + #endif /* PIKE_DEBUG */ + } + } + + PMOD_EXPORT void prepend_list_node(struct pike_list_node *node, + struct pike_list_node *new_node) + { + #ifdef PIKE_DEBUG + if (!node) { + Pike_fatal("No node to prepend.\n"); + } + if (!node->prev) { + Pike_fatal("Prepending unhooked node.\n"); + } + if (!new_node) { + Pike_fatal("Prepending NULL node.\n"); + } + if (new_node->next || new_node->prev) { + Pike_fatal("Prepending hooked node.\n"); + } + #endif /* PIKE_DEBUG */ + new_node->next = node; + new_node->prev = node->prev; + new_node->prev->next = node->prev = new_node; + add_ref(new_node); + add_ref(new_node); + } + + PMOD_EXPORT void append_list_node(struct pike_list_node *node, + struct pike_list_node *new_node) + { + #ifdef PIKE_DEBUG + if (!node) { + Pike_fatal("No node to append.\n"); + } + if (!node->next) { + Pike_fatal("Appending unhooked node.\n"); + } + if (!new_node) { + Pike_fatal("Appending NULL node.\n"); + } + if (new_node->next || new_node->prev) { + Pike_fatal("Appending hooked node.\n"); + } + #endif /* PIKE_DEBUG */ + new_node->next = node->next; + new_node->prev = node; + new_node->next->prev = node->next = new_node; + add_ref(new_node); + add_ref(new_node); + } + + /*! @module Builtin + */ + + /*! @class Setter + *! + *! Internal class for implementing setters. + */ + PIKECLASS Setter + { + PIKEVAR object o + flags ID_PROTECTED|ID_PRIVATE|ID_LOCAL; + CVAR int f; + PIKEFUN void `()(mixed val) + flags ID_PROTECTED; + { + if (!THIS->o) { + Pike_error("Uninitialized Setter!\n"); + } + object_low_set_index(THIS->o, THIS->f, Pike_sp-1); + pop_n_elems(args); + push_int(0); + } + PIKEFUN string _sprintf(int c, mapping|void opts) + flags ID_PROTECTED; + { + struct program *prog; + if (!THIS->o) { + push_constant_text("Setter()"); + } else if ((prog = THIS->o->prog)) { + push_constant_text("%O->`%s="); + ref_push_object(THIS->o); + ref_push_string(ID_FROM_INT(prog, THIS->f)->name); + f_sprintf(3); + } else { + push_constant_text("Setter(destructed object)"); + } + stack_pop_n_elems_keep_top(args); + } + } + + PMOD_EXPORT struct object *get_setter(struct object *o, int f) + { + struct object *res = clone_object(Setter_program, 0); + struct Setter_struct *setter = OBJ2_SETTER(res); + add_ref(setter->o = o); + setter->f = f; + return res; + } + + /*! @decl function(mixed_void) _get_setter(object o, string s) + *! + *! Get a setter for the variable named @[s] in object @[o]. + *! + *! @seealso + *! @[object_variablep()] + */ + PIKEFUN function(mixed:void) _get_setter(object o, string s) + { + struct program *p; + struct inherit *inh; + int f; + if (!(p = o->prog)) { + Pike_error("Indexing a destructed object.\n"); + } + inh = p->inherits + SUBTYPEOF(Pike_sp[-args]); + p = inh->prog; + f = find_shared_string_identifier(s, p); + if ((f >= 0) && + IDENTIFIER_IS_VARIABLE(ID_FROM_INT(p, f)->identifier_flags)) { + f += inh->identifier_level; + push_function(get_setter(o, f), f_Setter_cq__backtick_28_29_fun_num); + } else { + push_undefined(); + } + stack_pop_n_elems_keep_top(args); + } + + /*! @endclass + */ + + /*! @class Null + *! + *! This class is used to implement the low-level aspects of @[Val.Null]. + *! + *! @note + *! This class should typically not be used directly. Use + *! @[Val.Null] instead. + *! + *! @note + *! This class was previously available as @[Sql.Null]. Any such use + *! should be replaced with @[Val.Null]. + *! + *! @deprecated Val.Null + *! + *! @seealso + *! @[Val.Null], @[Val.null] + */ + PIKECLASS Null + { + EXTRA { + /*! @decl constant is_val_null = 1 + *! + *! Nonzero recognition constant. + */ + add_integer_constant("is_val_null", 1, 0); + + /*! @decl constant is_sql_null = 1 + *! + *! SQL Null marker. + *! + *! @deprecated is_val_null + */ + add_integer_constant("is_sql_null", 1, 0); + } + + PIKEFUN int `!() + flags ID_PROTECTED; + { + RETURN 1; + } + + PIKEFUN string _sprintf(int fmt, mixed ... extras) + flags ID_PROTECTED; + { + pop_n_elems(args); + if (fmt == 'O') { + push_constant_text("Val.null"); + } else { + push_undefined(); + } + } + + PIKEFUN int __hash() + flags ID_PROTECTED; + { + pop_n_elems(args); + push_int(17); + } + + PIKEFUN int `==(mixed other) + flags ID_PROTECTED; + { + if (TYPEOF(*other) != T_OBJECT) { + pop_stack(); + push_int(0); + return; + } + + /* Look for the is_val_null constant directly in the program of + * other, without going through its `[]. When this is called in a + * codec, other can be a completely arbitrary object which may not + * have a `[] that works in that context. */ + push_int (0); + ref_push_program (other->u.object->prog); + push_constant_text("is_val_null"); + if (program_index_no_free (Pike_sp - 3, Pike_sp - 2, Pike_sp - 1) && + TYPEOF(Pike_sp[-3]) == T_INT && Pike_sp[-3].u.integer) { + pop_n_elems (4); + push_int (1); + } + else { + pop_n_elems (4); + push_int (0); + } + } + + /*! @decl string encode_json() + *! + *! Defined for use with @[Standards.JSON.encode], so that it + *! formats NULL as @expr{null@}. + */ + PIKEFUN string encode_json(...) + { + push_constant_text ("null"); + } + } + + /*! @endclass + */ + + PMOD_EXPORT + PIKEFUN int levenshtein_distance(string a, string b) + { + int i, j, n, *lev_i, *lev_p; + + /* Simple cases: strings are equal or one of them is empty: */ + if (a == b) RETURN 0; + if (a->len == 0) RETURN b->len; + if (b->len == 0) RETURN a->len; + + /* Return -1 if any of the strings is wider than 8 bits: */ + if (a->size_shift || b->size_shift) RETURN -1; + + /* Allocate two rows on the stack: */ + n = b->len+1; + lev_i = alloca(n*sizeof(int)); + lev_p = alloca(n*sizeof(int)); + if (!lev_i || !lev_p) RETURN -1; + + /* Initialise the first row */ + for (j = 0; j < n; j++) lev_i[j] = j; + + for (i = 0; i < a->len; i++) + { + /* lev_p = row for i, lev_i = row for i+1: */ + memcpy(lev_p, lev_i, n*sizeof(int)); + lev_i[0] = i + 1; + for (j = 0; j < b->len; j++) + { + int cost = (a->str[i] == b->str[j]) ? 0 : 1; + int test, min_val = lev_i[j]+1; + if ((test = lev_p[j+1]+1) < min_val) min_val = test; + if ((test = lev_p[j]+cost) < min_val) min_val = test; + lev_i[j+1] = min_val; + } + } + RETURN lev_i[b->len]; + } + + /*! @endmodule + */ + + /*! @module Serializer + */ + + /*! @class Serializable + *! + *! The base class for serializable objects. + *! + *! Inherit this class in classes that need to be serializable. + *! + *! @seealso + *! @[Serializer.serialize()], @[Serializer.deserialize()] + */ + PIKECLASS Serializable + { + /* Loop over all variables, and call fun_num in the current object. */ + static void low_serialize(int i, struct svalue *fun, + int use_setter, int fun_num) + { + struct inherit *inh; + struct program *p = Pike_fp->current_object->prog; + struct svalue *save_sp = Pike_sp; + + inh = p->inherits + i; + p = inh->prog; + + for (i = 0; i < p->num_identifier_references; i++) { + struct reference *ref = PTR_FROM_INT(p, i); + struct identifier *id; + if ((ref->id_flags & ID_HIDDEN) || + ((ref->id_flags & (ID_PRIVATE|ID_INHERITED)) == + (ID_PRIVATE|ID_INHERITED))) { + continue; + } + id = ID_FROM_PTR(p, ref); + if (!IDENTIFIER_IS_VARIABLE(id->identifier_flags)) { + continue; + } + push_svalue(fun); + if (use_setter) { + push_function(get_setter(Pike_fp->current_object, + i + inh->identifier_level), + f_Setter_cq__backtick_28_29_fun_num); + } else { + low_object_index_no_free(Pike_sp, Pike_fp->current_object, + i + inh->identifier_level); + Pike_sp++; + } + ref_push_string(id->name); + ref_push_type_value(id->type); + apply_current(fun_num, 4); + pop_stack(); + } + if (Pike_sp != save_sp) { + /* Not likely, but... */ + pop_n_elems(Pike_sp - save_sp); + } + } + + /*! @decl protected void _serialize_variable( @ + *! function(mixed, string, type:void) serializer, @ + *! mixed value, @ + *! string symbol, @ + *! type symbol_type) + *! + *! Default serialization function for variables. + *! + *! @param serializer + *! Function to be called in turn. + *! + *! @param value + *! Value of the variable. + *! + *! @param symbol + *! Variable name. + *! + *! @param symbol_type + *! Type of the variable. + *! + *! This function is typically called from @[_serialize()], and just does + *! @code + *! serializer(value, symbol, symbol_type); + *! @endcode + *! + *! It is provided for overloading for eg filtering or validation purposes. + *! + *! @seealso + *! @[_serialize()], @[_deserialize_variable()] + */ + PIKEFUN void _serialize_variable(function(mixed, string, type:void) + serializer, mixed value, + string symbol, type symbol_type) + flags ID_PROTECTED; + rawtype tFunc(tFunc(tMix tStr tType(tMix), tVoid) + tMix tStr tType(tMix), tVoid); + { + f_call_function(args); + pop_stack(); + push_int(0); + } + + /*! @decl protected void _serialize(object o, @ + *! function(mixed, string, type:void) serializer) + *! + *! Dispatch function for serialization. + *! + *! @param o + *! Object to serialize. Always a context of the current object. + *! + *! @param serializer + *! Function to typically be called once for every variable + *! in the inheriting class. + *! + *! This function calls @[_serialize_variable()] once + *! for every variable in the inheriting class. + *! + *! @note + *! The symbols will be listed in the order they were defined + *! in the class. + *! + *! @note + *! This function is typically called via @[Serializer.serialize()]. + */ + PIKEFUN void _serialize(object o, + function(mixed, string, type:void) serializer) + flags ID_PROTECTED; + rawtype tFunc(tObj tFunc(tMix tStr tType(tMix), tVoid), tVoid); + { + if (o != Pike_fp->current_object) { + SIMPLE_BAD_ARG_ERROR("_serialize", 1, "this"); + } + low_serialize(SUBTYPEOF(Pike_sp[-args]), serializer, 0, + f_Serializable_cq__serialize_variable_fun_num); + pop_n_elems(args); + push_int(0); + } + + static void *find_program_from_object_type_cb(struct pike_type *t) + { + struct program *p; + if ((t->type != PIKE_T_OBJECT) || !t->cdr) return NULL; + p = id_to_program(CDR_TO_INT(t)); + if (!p || (p->flags & PROGRAM_NEEDS_PARENT) || + (low_find_lfun(p, LFUN__DESERIALIZE) == -1)) return NULL; + return p; + } + + DEFAULT_CMOD_STORAGE void f_deserialize(INT32 args); + + /*! @decl protected void _deserialize_variable( @ + *! function(function(mixed:void), @ + *! string, type: void) deserializer, @ + *! function(mixed:void) setter, @ + *! string symbol, @ + *! type symbol_type) + *! + *! Default deserialization function for variables. + *! + *! @param deserializer + *! Function to be called in turn. + *! + *! @param setter + *! Function that sets the value of the variable. + *! + *! @param symbol + *! Variable name. + *! + *! @param symbol_type + *! Type of the variable. + *! + *! This function is typically called from @[_deserialize()], and does + *! something like: + *! @code + *! if (object_typep(symbol_type)) { + *! program p = program_from_type(symbol_type); + *! if (p && !needs_parent(p) && is_deserializable(p)) { + *! object value = p(); + *! setter(value); + *! Serializer.deserialize(value, deserializer); + *! return; + *! } + *! } + *! deserializer(setter, symbol, symbol_type); + *! @endcode + *! + *! @note + *! The above takes care of the most common cases, but + *! @ul + *! @item + *! Does not support anonymous object types. + *! @item + *! Does not support objects needing a parent. + *! @item + *! Does not support non-serializable objects. + *! @item + *! Selects one of the object types in case of a complex + *! @[symbol_type]. The selected type is NOT deterministic + *! in case there are multiple choices that satisfy the above. + *! @item + *! Is likely to throw errors if @tt{p()@} requires arguments. + *! @endul + *! + *! These issues can all be solved by overloading this function. + *! + *! @seealso + *! @[_deserialize()], @[_serialize_variable()] + */ + PIKEFUN void _deserialize_variable(function(function(mixed:void), + string, type: void) + deserializer, function(mixed:void) setter, + string symbol, + type symbol_type) + flags ID_PROTECTED; + rawtype tFunc(tFunc(tFunc(tMix, tVoid) tStr tType(tMix), tVoid) + tFunc(tMix, tVoid) tStr tType(tMix), tVoid); + { + struct program *p = find_type(symbol_type, + find_program_from_object_type_cb); + if (p) { + struct object *o = clone_object(p, 0); + push_object(o); /* Protection against errors and arg to deserialize. */ + ref_push_object(o); + apply_svalue(setter, 1); + pop_stack(); + push_svalue(deserializer); + f_deserialize(2); + return; + } + f_call_function(args); + pop_stack(); + push_int(0); + } + + /*! @decl protected void _deserialize(object o, @ + *! function(function(mixed:void), @ + *! string, type: void) deserializer) + *! + *! Dispatch function for deserialization. + *! + *! @param o + *! Object to serialize. Always a context of the current object. + *! + *! @param deserializer + *! Function to typically be called once for every variable + *! in the inheriting class. + *! + *! This function calls @[_deserialize_variable()] once + *! for every variable in the inheriting class. + *! + *! @note + *! The symbols will be listed in the order they were defined + *! in the class. + *! + *! @note + *! This function is typically called via @[Serializer.deserialize()]. + */ + PIKEFUN void _deserialize(object o, + function(function(mixed:void), + string, type: void) deserializer) + flags ID_PROTECTED; + rawtype tFunc(tObj tFunc(tFunc(tMix, tVoid) tStr tType(tMix), tVoid), tVoid); + { + if (o != Pike_fp->current_object) { + SIMPLE_BAD_ARG_ERROR("_serialize", 1, "this"); + } + low_serialize(SUBTYPEOF(Pike_sp[-args]), deserializer, 1, + f_Serializable_cq__deserialize_variable_fun_num); + pop_n_elems(args); + push_int(0); + } + } + /*! @endclass + */ + + /*! @decl void serialize(object o, @ + *! function(mixed, string, type:void) serializer) + *! + *! Call @[lfun::_serialize()] in @[o]. + *! + *! @seealso + *! @[deserialize()], @[lfun::_serialize()], + *! @[Serializable()->_serialize()] + */ + PIKEFUN void serialize(object o, + function(mixed, string, type:void) serializer) + rawtype tFunc(tObj tFunc(tMix tStr tType(tMix), tVoid), tVoid); + { + struct inherit *inh; + struct program *p; + ptrdiff_t fun; + if (!(p = o->prog)) { + Pike_error("Indexing a destructed object.\n"); + } + inh = p->inherits + SUBTYPEOF(Pike_sp[-args]); + p = inh->prog; + if ((fun = low_find_lfun(p, LFUN__SERIALIZE)) == -1) { + Pike_error("Serialization not supported by object.\n"); + } + apply_low(o, fun + inh->identifier_level, args); + } + + /*! @decl void deserialize(object o, @ + *! function(function(mixed:void), @ + *! string, type: void) deserializer) + *! + *! Call @[lfun::_deserialize()] in @[o]. + *! + *! @seealso + *! @[serialize()], @[lfun::_deserialize()], + *! @[Serializable()->_deserialize()] + */ + PIKEFUN void deserialize(object o, + function(function(mixed:void), + string, type:void) deserializer) + rawtype tFunc(tObj tFunc(tFunc(tMix, tVoid) tStr tType(tMix), tVoid), tVoid); + { + struct inherit *inh; + struct program *p; + ptrdiff_t fun; + if (!(p = o->prog)) { + Pike_error("Indexing a destructed object.\n"); + } + inh = p->inherits + SUBTYPEOF(Pike_sp[-args]); + p = inh->prog; + if ((fun = low_find_lfun(p, LFUN__DESERIALIZE)) == -1) { + Pike_error("Deserialization not supported by object.\n"); + } + apply_low(o, fun + inh->identifier_level, args); + } + + /*! @endmodule + */ + + /*! @module ADT + */ + + /*! @class List + *! + *! Linked list of values. + */ + PIKECLASS List + { + CVAR struct pike_list_node *head; + CVAR INT32 head_sentinel_refs; + CVAR struct pike_list_node *tail; /* Always NULL. */ + CVAR INT32 tail_sentinel_refs; + CVAR struct pike_list_node *tail_pred; + CVAR INT32 num_elems; + + #define HEAD_SENTINEL(this) ((struct pike_list_node *)(&this->head)) + #define TAIL_SENTINEL(this) ((struct pike_list_node *)(&this->tail)) + + /* Sentinel overlap description: + * + * List Head sentinel Tail sentinel + * head next + * head_sentinel_refs refs + * tail prev next + * tail_sentinel_refs refs + * tail_pred prev + */ + + /* Suggestions for future functionality: + * + * o Pop tail + * o Join + * o Copy segment + * o Detach segment (requires new iterator implementation) + * o Iterator copy + * o _equal() for iterators and lists. + * o _values(), _search(), cast() + * o _sizeof()?, _indices()?? + * o Support for reverse(), filter() and map(). + * o Initialization from array. + * o Support for Pike.count_memory. + */ + + INIT + { + THIS->tail = NULL; + THIS->head = TAIL_SENTINEL(THIS); + THIS->tail_pred = HEAD_SENTINEL(THIS); + THIS->head_sentinel_refs = THIS->tail_sentinel_refs = 2; + THIS->num_elems = 0; + } + + EXIT + gc_trivial; + { + struct pike_list_node *node = THIS->head; + struct pike_list_node *next; + while ((next = node->next)) { + #ifdef PIKE_DEBUG + if (node->refs != 2) { + Pike_fatal("Unexpected number of references for node: %d\n", + node->refs); + } + #endif /* PIKE_DEBUG */ + unlink_list_node(node); + node = next; + } + } + + /* These two functions perform the same thing, + * but are optimized to minimize recursion. + */ + static void gc_check_list_node_backward(struct pike_list_node *node, + const char *msg); + static void gc_check_list_node_forward(struct pike_list_node *node, + const char *msg) + { + while (node && !debug_gc_check(&node->refs, msg)) { + if (node->next) + debug_gc_check_svalues(&node->val, 1, " as a list node value"); + gc_check_list_node_backward(node->prev, msg); + node = node->next; + } + } + + static void gc_check_list_node_backward(struct pike_list_node *node, + const char *msg) + { + while (node && !debug_gc_check(&node->refs, msg)) { + if (node->prev) + debug_gc_check_svalues(&node->val, 1, " as a list node value"); + gc_check_list_node_forward(node->next, msg); + node = node->prev; + } + } + + /* Called at gc_check time. */ + GC_CHECK + { + gc_check_list_node_backward(HEAD_SENTINEL(THIS), " as a list node"); + gc_check_list_node_forward(TAIL_SENTINEL(THIS), " as a list node"); + } + + /* Called at gc_mark time */ + GC_RECURSE + { + struct pike_list_node *node = THIS->head; + struct pike_list_node *next; + while ((next = node->next)) { + gc_recurse_svalues(&node->val, 1); + node = next; + } + /* FIXME: mc_count_bytes */ + } + + /*! @decl int(0..1) is_empty() + *! + *! Check if the list is empty. + *! + *! @returns + *! Returns @expr{1@} if the list is empty, + *! and @expr{0@} (zero) if there are elements in the list. + */ + PIKEFUN int(0..1) is_empty() + { + push_int(!THIS->head->next); + } + + /*! @decl protected int(0..) _sizeof() + *! + *! Returns the number of elements in the list. + */ + PIKEFUN int(0..) _sizeof() + flags ID_PROTECTED; + { + push_int(THIS->num_elems); + } + + /*! @decl protected string _sprintf(int c, mapping(string:mixed)|void attr) + *! + *! Describe the list. + *! + *! @seealso + *! @[sprintf()], @[lfun::_sprintf()] + */ + PIKEFUN string _sprintf(int c, mapping(string:mixed)|void attr) + flags ID_PROTECTED; + { + if (!THIS->num_elems) { + push_constant_text("ADT.List(/* empty */)"); + } else if (c == 'O') { + struct pike_list_node *node = THIS->head; + if (THIS->num_elems == 1) { + push_constant_text("ADT.List(/* 1 element */\n"); + } else { + push_constant_text("ADT.List(/* %d elements */\n"); + push_int(THIS->num_elems); + f_sprintf(2); + } + while (node->next) { + if (node->next->next) { + push_constant_text(" %O,\n"); + } else { + push_constant_text(" %O\n"); + } + push_svalue(&node->val); + f_sprintf(2); + node = node->next; + } + push_constant_text(")"); + f_add(THIS->num_elems + 2); + } else { + if (THIS->num_elems == 1) { + push_constant_text("ADT.List(/* 1 element */)"); + } else { + push_constant_text("ADT.List(/* %d elements */)"); + push_int(THIS->num_elems); + f_sprintf(2); + } + } + stack_pop_n_elems_keep_top(args); + } + + /*! @decl mixed head() + *! + *! Get the element at the head of the list. + *! + *! @throws + *! Throws an error if the list is empty. + *! + *! @seealso + *! @[is_empty()], @[tail()], @[pop()] + */ + PIKEFUN mixed head() + { + if (THIS->head->next) { + push_svalue(&THIS->head->val); + } else { + Pike_error("Empty list.\n"); + } + } + + /*! @decl mixed tail() + *! + *! Get the element at the tail of the list. + *! + *! @throws + *! Throws an error if the list is empty. + *! + *! @seealso + *! @[is_empty()], @[head()], @[pop_back()] + */ + PIKEFUN mixed tail() + { + struct pike_list_node * node = TAIL_SENTINEL(THIS); + if (THIS->head->next) { + push_svalue(&node->prev->val); + } else { + Pike_error("Empty list.\n"); + } + } + + static inline void pop_node(struct pike_list_node * node) { + push_svalue(&node->val); + if (node->refs == 2) { + unlink_list_node(node); + } else { + detach_list_node(node); + } + THIS->num_elems--; + } + + /*! @decl mixed pop() + *! + *! Pop the element at the head of the list from the list. + *! + *! @throws + *! Throws an error if the list is empty. + *! + *! @seealso + *! @[is_empty()], @[head()], @[tail()], @[pop_back()] + */ + PIKEFUN mixed pop() + { + if (THIS->head->next) { + pop_node(THIS->head); + } else { + Pike_error("Empty list.\n"); + } + } + + /*! @decl mixed pop_back() + *! + *! Pop the element at the tail of the list from the list. + *! + *! @throws + *! Throws an error if the list is empty. + *! + *! @seealso + *! @[is_empty()], @[head()], @[tail()], @[pop()] + */ + PIKEFUN mixed pop_back() + { + const struct pike_list_node * node = TAIL_SENTINEL(THIS); + if (THIS->head->next) { + pop_node(node->prev); + } else { + Pike_error("Empty list.\n"); + } + } + + /*! @decl array _values() + *! + *! Returns an array of elements in the list. + */ + PIKEFUN array _values() + flags ID_PROTECTED; + { + struct array * a; + push_int(THIS->num_elems); + f_allocate(1); + + a = Pike_sp[-1].u.array; + if (THIS->num_elems) { + struct pike_list_node *node = THIS->head; + int i; + for (i = 0; i < THIS->num_elems; i++) { + assign_svalue_no_free(ITEM(a) + i, &node->val); + node = node->next; + } + } + } + + /*! @decl mixed cast(string type) + *! + *! Cast the lists. @expr{array@} and @expr{object@} are the only + *! supported types. + */ + PIKEFUN mixed cast(string type) + flags ID_PROTECTED; + { + if (type == MK_STRING("array")) { + pop_n_elems(args); + apply_current(f_List_cq__values_fun_num, 0); + } else if (type == MK_STRING("object")) { + pop_n_elems(args); + ref_push_object(Pike_fp->current_object); + } else { + Pike_error("Cannot cast to %o.\n", Pike_sp-1); + } + } + + + /*! @decl mixed `[](mixed key) */ + PIKEFUN mixed `[](mixed key) + flags ID_PROTECTED; + { + struct pike_list_node *node; + INT_TYPE n; + if (TYPEOF(*key) != PIKE_T_INT) SIMPLE_BAD_ARG_ERROR("`[]", 1, "int"); + + n = key->u.integer; + if (n < 0) n = -(n+1); + + if (n >= THIS->num_elems) Pike_error("out of bounds"); + + if (n >= THIS->num_elems >> 1) { /* use shorter direction */ + n = THIS->num_elems - n - 1; + key->u.integer = - key->u.integer - 1; + } + + if (key->u.integer < 0) { + node = TAIL_SENTINEL(THIS)->prev; + while (n--) node = node->prev; + } else { + node = THIS->head; + while (n--) node = node->next; + } + + pop_n_elems(args); + push_svalue(&node->val); + } + + /*! @decl void append(mixed ... values) + *! + *! Append @[values] to the end of the list. + *! + *! @seealso + *! @[insert()] + */ + PIKEFUN void append(mixed ... values) + { + struct pike_list_node *node = TAIL_SENTINEL(THIS); + while (args--) { + struct pike_list_node *new_node = alloc_pike_list_node(); + new_node->val = *(--Pike_sp); + prepend_list_node(node, new_node); + free_list_node(node = new_node); + THIS->num_elems++; + } + push_int(0); + } + + /*! @decl void insert(mixed ... values) + *! + *! Insert @[values] at the front of the list. + *! + *! @seealso + *! @[append()] + */ + PIKEFUN void insert(mixed ... values) + { + struct pike_list_node *node = THIS->head; + while (args--) { + struct pike_list_node *new_node = alloc_pike_list_node(); + new_node->val = *(--Pike_sp); + prepend_list_node(node, new_node); + free_list_node(node = new_node); + THIS->num_elems++; + } + push_int(0); + } + + /*! @decl void flush() + *! + *! Empties the List. + */ + PIKEFUN void flush() { + if (THIS->num_elems) { + while (THIS->head->next) { + if (THIS->head->refs == 2) + unlink_list_node(THIS->head); + else + detach_list_node(THIS->head); + } + THIS->num_elems = 0; + } + } + + /*! @decl protected void create(mixed ... values) + *! + *! Create a new @[List], and initialize it with @[values]. + */ + PIKEFUN void create(mixed ... values) + flags ID_PROTECTED; + { + if (THIS->num_elems) + apply_current(f_List_flush_fun_num, 0); + apply_current(f_List_append_fun_num, args); + } + + /*! @class _get_iterator + *! + *! @[Iterator] that loops over the @[List]. + */ + PIKECLASS _get_iterator + program_flags PROGRAM_USES_PARENT; + flags ID_PROTECTED; + { + CVAR struct pike_list_node *cur; + CVAR INT32 ind; /* Not meaningful, but requred by the API. */ + + /* NOTE: cur may never refer to an unlinked node. + * cur may however refer to a detached node, or to sentinels. + */ + + static struct List_struct *List__get_iterator_find_parent() + { + struct external_variable_context loc; + + loc.o = Pike_fp->current_object; + loc.parent_identifier = Pike_fp->fun; + loc.inherit = Pike_fp->context; + find_external_context(&loc, 1); + return (struct List_struct *)(loc.o->storage + + loc.inherit->storage_offset); + } + + INIT + { + add_ref(THIS->cur = List__get_iterator_find_parent()->head); + THIS->ind = 0; + } + + EXIT + gc_trivial; + { + if (THIS->cur) { + free_list_node(THIS->cur); + THIS->cur = NULL; + } + } + + /* Called at gc_check time. */ + GC_CHECK + { + gc_check_list_node_forward(THIS->cur, " held by an iterator"); + } + + /* These two functions perform the same thing, + * but are optimized to minimize recursion. + */ + static void gc_recurse_list_node_tree_backward(struct pike_list_node *node, + struct pike_list_node *back); + static void gc_recurse_list_node_tree_forward(struct pike_list_node *node, + struct pike_list_node *back) + { + if (!node || !node->next) return; + if (node->next->prev == node) { + /* List member. Recursed from the list recurse code. */ + #ifdef PIKE_DEBUG + if (node->prev->next != node) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + return; + } + #ifdef PIKE_DEBUG + if (node->prev->next == node) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + while (1) { + gc_recurse_svalues(&node->val, 1); + if (node->prev != back) + gc_recurse_list_node_tree_backward(node->prev, node->next); + back = node->prev; + node = node->next; + if (!node->next || (node->next->prev == node)) { + /* List member. Recursed from the list recurse code. */ + #ifdef PIKE_DEBUG + if (node->prev->next != node) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + break; + } + #ifdef PIKE_DEBUG + if (node->prev->next == node) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + } + } + + static void gc_recurse_list_node_tree_backward(struct pike_list_node *node, + struct pike_list_node *next) + { + if (!node || !node->prev) return; + if (node->prev->next == node) { + /* List member. Checked from the list check code. */ + #ifdef PIKE_DEBUG + if (node->next->prev != node) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + return; + } + #ifdef PIKE_DEBUG + if (node->next->prev == node) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + while (1) { + gc_recurse_svalues(&node->val, 1); + if (node->next != next) + gc_recurse_list_node_tree_forward(node->next, node->prev); + next = node->next; + node = node->prev; + if (!node->prev || (node->prev->next == node)) { + /* List member. Recursed from the list recurse code. */ + #ifdef PIKE_DEBUG + if (node->next->prev != node) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + break; + } + #ifdef PIKE_DEBUG + if (node->next->prev == node) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + } + } + + /* Called at gc_mark time */ + GC_RECURSE + { + if (!THIS->cur->next || !THIS->cur->prev) return; + if (THIS->cur->next->prev == THIS->cur) { + #ifdef PIKE_DEBUG + if (THIS->cur->prev->next != THIS->cur) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + return; + } + #ifdef PIKE_DEBUG + if (THIS->cur->prev->next == THIS->cur) { + Pike_fatal("Partially detached node.\n"); + } + #endif /* PIKE_DEBUG */ + /* Detached node. */ + gc_recurse_svalues(&THIS->cur->val, 1); + gc_recurse_list_node_tree_forward(THIS->cur->next, THIS->cur->prev); + gc_recurse_list_node_tree_backward(THIS->cur->next, THIS->cur->prev); + } + + PIKEFUN int(0..1) `!() + flags ID_PROTECTED; + { + pop_n_elems(args); + push_int(!THIS->cur->next || !THIS->cur->prev); + } + + PIKEFUN int(0..) index() + { + pop_n_elems(args); + if (THIS->cur->next && THIS->cur->prev) { + push_int(THIS->ind); + } else { + push_undefined(); + } + } + + /*! @decl mixed value() + *! + *! @returns + *! Returns the value at the current position. + */ + PIKEFUN mixed value() + { + pop_n_elems(args); + if (THIS->cur->next && THIS->cur->prev) { + push_svalue(&THIS->cur->val); + } else { + push_undefined(); + } + } + + /*! @decl int(0..1) first() + *! + *! Reset the iterator to point to the first element in + *! the list. + *! + *! @returns + *! Returns @expr{1@} if there are elements in the list, + *! and @expr{0@} (zero) if the list is empty. + */ + PIKEFUN int(0..1) first() + { + struct external_variable_context loc; + struct List_struct *parent; + pop_n_elems(args); + + /* Find our parent. */ + loc.o = Pike_fp->current_object; + loc.parent_identifier = Pike_fp->fun; + loc.inherit = INHERIT_FROM_INT(loc.o->prog, loc.parent_identifier); + find_external_context(&loc, 1); + parent = (struct List_struct *)(loc.o->storage + + loc.inherit->storage_offset); + free_list_node(THIS->cur); + add_ref(THIS->cur = parent->head); + THIS->ind = 0; + pop_n_elems(args); + if (THIS->cur->next) { + push_int(1); + } else { + push_undefined(); + } + } + + /*! @decl int(0..1) next() + *! + *! Advance to the next element in the list. + *! + *! @returns + *! Returns @expr{1@} on success, and @expr{0@} (zero) + *! at the end of the list. + *! + *! @seealso + *! @[prev()] + */ + PIKEFUN int(0..1) next() + { + struct pike_list_node *next; + if ((next = THIS->cur->next)) { + free_list_node(THIS->cur); + add_ref(THIS->cur = next); + THIS->ind++; + if (next->next) { + pop_n_elems(args); + push_int(1); + return; + } + } + pop_n_elems(args); + push_int(0); + } + + /*! @decl int(0..1) prev() + *! + *! Retrace to the previous element in the list. + *! + *! @returns + *! Returns @expr{1@} on success, and @expr{0@} (zero) + *! at the beginning of the list. + *! + *! @seealso + *! @[next()] + */ + PIKEFUN int(0..1) prev() + { + struct pike_list_node *prev; + if ((prev = THIS->cur->prev)) { + free_list_node(THIS->cur); + add_ref(THIS->cur = prev); + THIS->ind--; + if (prev->prev) { + pop_n_elems(args); + push_int(1); + return; + } + } + pop_n_elems(args); + push_int(0); + } + + /*! @decl Iterator `+=(int steps) + *! + *! Advance or retrace the specified number of @[steps]. + *! + *! @seealso + *! @[next()], @[prev] + */ + PIKEFUN Iterator `+=(int steps) + { + if (!steps) return; + if (steps > 0) { + while (steps--) { + apply_current(f_List_cq__get_iterator_next_fun_num, 0); + pop_stack(); + } + } else { + while (steps++) { + apply_current(f_List_cq__get_iterator_prev_fun_num, 0); + pop_stack(); + } + } + pop_n_elems(args); + ref_push_object(Pike_fp->current_object); + } + + /*! @decl void insert(mixed val) + *! + *! Insert @[val] at the current position. + *! + *! @seealso + *! @[append()], @[delete()], @[set()] + */ + PIKEFUN void insert(mixed val) + { + struct pike_list_node *new_node; + if (!THIS->cur->prev) { + Pike_error("Attempt to insert before the start sentinel.\n"); + } + new_node = alloc_pike_list_node(); + assign_svalue_no_free(&new_node->val, val); + prepend_list_node(THIS->cur, new_node); + free_list_node(THIS->cur); + THIS->cur = new_node; + List__get_iterator_find_parent()->num_elems++; + pop_n_elems(args); + push_int(0); + } + + /*! @decl void append(mixed val) + *! + *! Append @[val] after the current position. + *! + *! @seealso + *! @[insert()], @[delete()], @[set()] + */ + PIKEFUN void append(mixed val) + { + struct pike_list_node *new_node; + if (!THIS->cur->next) { + Pike_error("Attempt to append after the end sentinel.\n"); + } + new_node = alloc_pike_list_node(); + assign_svalue_no_free(&new_node->val, val); + append_list_node(THIS->cur, new_node); + free_list_node(new_node); + List__get_iterator_find_parent()->num_elems++; + pop_n_elems(args); + push_int(0); + } + + /*! @decl void delete() + *! + *! Delete the current node. + *! + *! The current position will advance to the next node. + *! This function thus performes the reverse operation + *! of @[insert()]. + *! + *! @seealso + *! @[insert()], @[append()], @[set()] + */ + PIKEFUN void delete() + { + struct pike_list_node *next; + if (!(next = THIS->cur->next) || !THIS->cur->prev) { + Pike_error("Attempt to delete a sentinel.\n"); + } + add_ref(next); + if (next->prev == THIS->cur) { + if (THIS->cur->refs == 3) { + unlink_list_node(THIS->cur); + } else { + /* There's some other iterator holding references to this node. */ + detach_list_node(THIS->cur); + } + List__get_iterator_find_parent()->num_elems--; + } + free_list_node(THIS->cur); + THIS->cur = next; + pop_n_elems(args); + push_int(0); + } + + /*! @decl void set(mixed val) + *! + *! Set the value of the current position to @[val]. + *! + *! @seealso + *! @[insert()], @[append()], @[delete()] + */ + PIKEFUN void set(mixed val) + { + if (!THIS->cur->next || !THIS->cur->prev) { + Pike_error("Attempt to set a sentinel.\n"); + } + assign_svalue(&THIS->cur->val, val); + pop_n_elems(args); + push_int(0); + } + } + /*! @endclass + */ + } + /*! @endclass + */ + + /*! @endmodule + */ + + /*! @module Pike + */ + + /*! @class MasterCodec + *! + *! This is a bare-bones codec that is used when loading a dumped master. + *! + *! @seealso + *! @[Codec] + */ + PIKECLASS MasterCodec + flags ID_PROTECTED; + { + /*! @decl mixed functionof(mixed symbol) + *! Look up a function in @[all_constants()]. + */ + PIKEFUN mixed functionof(mixed symbol) + { + mapping_index_no_free(Pike_sp, get_builtin_constants(), symbol); + Pike_sp++; + stack_pop_keep_top(); + } + /*! @decl mixed objectof(mixed symbol) + *! Look up an object in @[all_constants()]. + */ + PIKEFUN mixed objectof(mixed symbol) + { + mapping_index_no_free(Pike_sp, get_builtin_constants(), symbol); + Pike_sp++; + stack_pop_keep_top(); + } + /*! @decl mixed programof(mixed symbol) + *! Look up a program in @[all_constants()]. + */ + PIKEFUN mixed programof(mixed symbol) + { + mapping_index_no_free(Pike_sp, get_builtin_constants(), symbol); + Pike_sp++; + stack_pop_keep_top(); + } + /*! @decl object decode_object(object obj, mixed data) + *! Calls @expr{obj->_decode(@[data])@}. + */ + PIKEFUN object decode_object(object obj, mixed data) + { + apply(obj, "_decode", 1); + pop_stack(); + } + } + + /*! @endclass + */ + + /*! @endmodule + */ + + static struct object *val_module; + + static void get_val_module() + { + assert (!val_module); + push_constant_text ("Val"); + APPLY_MASTER ("resolv", 1); + if (TYPEOF(Pike_sp[-1]) != T_OBJECT) + Pike_error ("\"Val\" didn't resolve to a module object.\n"); + val_module = (--Pike_sp)->u.object; + } + + /* Always do the lookup in the Val module dynamically to allow the + * values to be replaced. */ + #define GET_VAL(NAME) \ + PMOD_EXPORT struct object *PIKE_CONCAT (get_val_, NAME) (void) \ + { \ + struct svalue index, res; \ + if (!val_module) get_val_module(); \ + SET_SVAL(index, T_STRING, 0, string, NULL); \ + MAKE_CONST_STRING (index.u.string, TOSTR (NAME)); \ + object_index_no_free (&res, val_module, 0, &index); \ + if (TYPEOF(res) != T_OBJECT) \ + Pike_error ("\"Val." TOSTR (NAME) "\" didn't resolve to an object.\n"); \ + return res.u.object; \ + } + + GET_VAL (true) + GET_VAL (false) + GET_VAL (null) + + /* Kludge needed for the static null objects in the oracle module. It + * ought to be fixed to use dynamic lookup of them instead. */ + PMOD_EXPORT struct program *get_sql_null_prog(void) + { + return Null_program; + } + + PIKECLASS __Backtrace_Tester__ + { + INIT { + Pike_error("__Backtrace_Tester__\n"); + } + } + void init_builtin(void) { - + SET_SVAL(gc_pre_cb, PIKE_T_INT, NUMBER_NUMBER, integer, 0); + SET_SVAL(gc_post_cb, PIKE_T_INT, NUMBER_NUMBER, integer, 0); + SET_SVAL(gc_destruct_cb, PIKE_T_INT, NUMBER_NUMBER, integer, 0); + SET_SVAL(gc_done_cb, PIKE_T_INT, NUMBER_NUMBER, integer, 0); INIT } - + + void exit_builtin(void) + { + struct svalue zero; + if (val_module) free_object (val_module); + EXIT + SET_SVAL(zero, PIKE_T_INT, NUMBER_NUMBER, integer, 0); + assign_svalue(&gc_pre_cb, &zero); + assign_svalue(&gc_post_cb, &zero); + assign_svalue(&gc_destruct_cb, &zero); + assign_svalue(&gc_done_cb, &zero); + #ifndef DO_PIKE_CLEANUP + /* This is performed by exit_builtin_modules() at a later point + * in this case, so that the pike_list_node's are valid at cleanup + * time, thus avoiding "got invalid pointer" fatals at exit. + */ + ba_destroy(&pike_list_node_allocator); + #endif + #ifndef USE_SETENV + if (env_allocs) free_mapping (env_allocs); + #endif + }

pike.git / src / builtin.cmod