pike.git
/
src
/
builtin.cmod
version
»
Context lines:
10
20
40
80
file
none
3
pike.git/src/builtin.cmod:1:
/* -*- c -*-
-
*
$Id:
builtin
.
cmod
,
v
1
.
67
2001/09/28
00:01:43
hubbe
Exp
$
+
||
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"
+
#include "whitespace.h"
-
+
#include <ctype.h>
+
#include <errno.h>
+
#include <math.h>
-
+
DECLARATIONS
+
+
+
/*! @module System
+
*/
+
+
#if defined(HAVE_MKTIME) && defined(HAVE_GMTIME) && defined(HAVE_LOCALTIME)
+
/*! @class TM
+
*! A wrapper for the system struct tm time keeping structure.
+
*! This can be used as a (very) lightweight alternative to Calendar.
+
*/
+
PIKECLASS TM
+
{
+
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.
+
*!
+
*! @dl
+
*! @item %%
+
*! The % character.
+
*!
+
*! @item %a or %A
+
*! The weekday name according to the C locale, in abbreviated
+
*! form or the full name.
+
*!
+
*! @item %b or %B or %h
+
*! The month name according to the C locale, in abbreviated form
+
*! or the full name.
+
*!
+
*! @item %c
+
*! The date and time representation for the C locale.
+
*!
+
*! @item %C
+
*! The century number (0-99).
+
*!
+
*! @item %d or %e
+
*! The day of month (1-31).
+
*!
+
*! @item %D
+
*! Equivalent to %m/%d/%y.
+
*!
+
*! @item %H
+
*! The hour (0-23).
+
*!
+
*! @item %I
+
*! The hour on a 12-hour clock (1-12).
+
*!
+
*! @item %j
+
*! The day number in the year (1-366).
+
*!
+
*! @item %m
+
*! The month number (1-12).
+
*!
+
*! @item %M
+
*! The minute (0-59).
+
*!
+
*! @item %n
+
*! Arbitrary whitespace.
+
*!
+
*! @item %p
+
*! The C locale's equivalent of AM or PM.
+
*!
+
*! @item %R
+
*! Equivalent to %H:%M.
+
*!
+
*! @item %S
+
*! The second (0-60; 60 may occur for leap seconds;
+
*! earlier also 61 was allowed).
+
*!
+
*! @item %t
+
*! Arbitrary whitespace.
+
*!
+
*! @item %T
+
*! Equivalent to %H:%M:%S.
+
*!
+
*! @item %U
+
*! The week number with Sunday the first day of the week (0-53).
+
*!
+
*! @item %w
+
*! The weekday number (0-6) with Sunday = 0.
+
*!
+
*! @item %W
+
*! The week number with Monday the first day of the week (0-53).
+
*!
+
*! @item %x
+
*! The date, using the C locale's date format.
+
*!
+
*! @item %X
+
*! The time, using the C locale's time format.
+
*!
+
*! @item %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).
+
*!
+
*! @item %Y
+
*! The year, including century (for example, 1991).
+
*! @enddl
+
*!
+
*/
+
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.
+
*!
+
*! @dl
+
*! @item %a
+
*! The abbreviated weekday name according to the current locale
+
*!
+
*! @item %A
+
*! The full weekday name according to the current locale.
+
*!
+
*! @item %b
+
*! The abbreviated month name according to the current locale.
+
*!
+
*! @item %B
+
*! The full month name according to the current locale.
+
*!
+
*! @item %c
+
*! The preferred date and time representation for the current locale.
+
*!
+
*! @item %C
+
*! The century number (year/100) as a 2-digit integer.
+
*!
+
*! @item %d
+
*! The day of the month as a decimal number (range 01 to 31).
+
*!
+
*! @item %D
+
*! Equivalent to @expr{%m/%d/%y@}. (for Americans only.
+
*! Americans should note that in other countries @expr{%d/%m/%y@}
+
*! is rather common. This means that in international context
+
*! this format is ambiguous and should not be used.)
+
*!
+
*! @item %e
+
*! Like @expr{%d@}, the day of the month as a decimal number,
+
*! but a leading zero is replaced by a space.
+
*!
+
*! @item %E
+
*! Modifier: use alternative format, see below.
+
*!
+
*! @item %F
+
*! Equivalent to %Y-%m-%d (the ISO 8601 date format). (C99)
+
*!
+
*! @item %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 @expr{%V@}). This has the same format and
+
*! value as @expr{%Y@}, except that if the ISO week number
+
*! belongs to the previous or next year, that year is used instead.
+
*!
+
*! @item %g
+
*! Like @expr{%G@}, but without century, that is,
+
*! with a 2-digit year (00-99). (TZ)
+
*!
+
*! @item %h
+
*! Equivalent to %b.
+
*!
+
*! @item %H
+
*! The hour as a decimal number using a 24-hour clock (range 00 to 23).
+
*!
+
*! @item %I
+
*! The hour as a decimal number using a 12-hour clock (range 01 to 12).
+
*!
+
*! @item %j
+
*! The day of the year as a decimal number (range 001 to 366).
+
*!
+
*! @item %k
+
*! The hour (24-hour clock) as a decimal number (range 0 to 23);
+
*! single digits are preceded by a blank. (See also @expr{%H@}.)
+
*!
+
*! @item %l
+
*! The hour (12-hour clock) as a decimal number (range 1 to 12);
+
*! single digits are preceded by a blank. (See also @expr{%I@}.)
+
*!
+
*! @item %m
+
*! The month as a decimal number (range 01 to 12).
+
*!
+
*! @item %M
+
*! The minute as a decimal number (range 00 to 59).
+
*!
+
*! @item %n
+
*! A newline character. (SU)
+
*!
+
*! @item %O
+
*! Modifier: use alternative format, see below. (SU)
+
*!
+
*! @item %p
+
*! Either @expr{"AM"@} or @expr{"PM"@} according to the given time
+
*! value, or the corresponding strings for the current locale.
+
*! Noon is treated as @expr{"PM"@} and midnight as @expr{"AM"@}.
+
*!
+
*! @item %P
+
*! Like @expr{%p@} but in lowercase: @expr{"am"@} or @expr{"pm"@}
+
*! or a corresponding string for the current locale.
+
*!
+
*! @item %r
+
*! The time in a.m. or p.m. notation. In the POSIX locale this is
+
*! equivalent to @expr{%I:%M:%S %p@}.
+
*!
+
*! @item %R
+
*! The time in 24-hour notation (@expr{%H:%M@}). (SU)
+
*! For a version including the seconds, see @expr{%T@} below.
+
*!
+
*! @item %s
+
*! The number of seconds since the Epoch,
+
*! 1970-01-01 00:00:00 +0000 (UTC). (TZ)
+
*!
+
*! @item %S
+
*! The second as a decimal number (range 00 to 60).
+
*! (The range is up to 60 to allow for occasional leap seconds.)
+
*!
+
*! @item %t
+
*! A tab character. (SU)
+
*!
+
*! @item %T
+
*! The time in 24-hour notation (@expr{%H:%M:%S@}). (SU)
+
*!
+
*! @item %u
+
*! The day of the week as a decimal, range 1 to 7, Monday being 1.
+
*! See also @expr{%w@}. (SU)
+
*!
+
*! @item %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 @expr{%V@} and @expr{%W@}.
+
*!
+
*! @item %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 @expr{%U@} and @expr{%W@}.
+
*!
+
*! @item %w
+
*! The day of the week as a decimal, range 0 to 6, Sunday being 0.
+
*! See also @expr{%u@}.
+
*! @enddl
+
*/
+
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_undefined();
+
}
+
}
+
+
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 );
+
}
+
}
+
/*! @endclass
+
*/
+
#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; {
-
int t=x
->type
;
-
if(
x->type
== T_OBJECT && x->u.object->prog)
+
int t
=
TYPEOF(*
x
)
;
+
struct program *p;
+
if(
t
== T_OBJECT &&
(p =
x->u.object->prog)
)
{
-
ptrdiff_t fun=FIND_LFUN(
x
->
u
.
object->
prog, LFUN__SPRINTF);
+
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, 2);
-
if(Pike_sp[-1]
.type
== T_STRING)
+
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 (IS_ZERO(Pike_sp-1)) {
+
} 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_LVALUE: push_constant_text("lvalue"); 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; } } /*! @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; { int c;
-
if(x
->type
== T_OBJECT && x->u.object->prog)
+
struct program *p;
+
if(
TYPEOF(*
x
)
== T_OBJECT &&
(p =
x->u.object->prog)
)
{
-
ptrdiff_t fun=FIND_LFUN(
x
->
u
.
object->
prog, LFUN__SPRINTF);
+
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, 2);
-
if(Pike_sp[-1]
.type
== T_STRING)
+
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(x
->type
!= T_INT)
-
Pike
_
error
("
Bad
argument
1
to int2char.\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
sprintf
("%x",x);
+
*! 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
long
n;
+
unsigned
INT_TYPE
n;
int len; struct pike_string *s;
-
+
struct program *p;
-
if(x
->type
== T_OBJECT && x->u.object->prog)
+
if(
TYPEOF(*
x
)
== T_OBJECT &&
(p =
x->u.object->prog)
)
{
-
ptrdiff_t fun=FIND_LFUN(
x
->
u
.
object->
prog, LFUN__SPRINTF);
+
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, 2);
-
if(Pike_sp[-1]
.type
== T_STRING)
+
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(x
->type
!= T_INT)
-
Pike
_
error
("
Bad
argument
1
to int2hex.\n
");
+
if(
TYPEOF(*
x
)
!= T_INT)
+
SIMPLE
_
BAD_ARG_ERROR
("
int2hex",
1
,
"
int"
);
c=x->u.integer; len=1; if(c<0) { len++;
-
n=-c;
+
n=
(
-c
)&((unsigned INT_TYPE)(-1))
;
}else{ n=c; }
-
while(n>
65536
) { n>>=16; len+=4; }
-
while(n>
16
) { n>>=4; len++; }
+
while(n>
65535
) { n>>=16; len+=4; }
+
while(n>
15
) { n>>=4; len++; }
s=begin_shared_string(len);
-
c=x->u.integer;
+
if(!c) { s->str[0]='0'; }else{ if(c<0) { s->str[0]='-';
-
n=-c;
+
n=
(
-c
)&((unsigned INT_TYPE)(-1))
;
}else{ n=c; }
-
while(n)
+
while(
len &&
n)
{ s->str[--len]="0123456789abcdef"[n&0xf]; n>>=4; } } RETURN end_shared_string(s); }
-
+
+
/*! @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(0..255) 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++;
+
}
+
+
RETURN end_shared_string(hex);
+
}
+
+
/*! @decl string hex2string(string hex)
+
*! @appears String.hex2string
+
*!
+
*! Convert a string of hexadecimal digits to binary data.
+
*!
+
*! @seealso
+
*! @[string2hex()]
+
*/
+
PMOD_EXPORT
+
PIKEFUN string(0..255) 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(int) range(string s)
+
*! @appears String.range
+
*!
+
*! Returns the character range of a string in an array of two
+
*! elements. The first element contains the lower bound and the
+
*! second the upper. The precision is only 8 bits, so for wide
+
*! strings only character blocks are known.
+
*/
+
PIKEFUN array(int) string_range(string s)
+
errname String.range;
+
optflags OPT_TRY_OPTIMIZE;
+
{
+
int min, max;
+
check_string_range(s, 0, &min, &max);
+
pop_n_elems(args);
+
push_int(min);
+
push_int(max);
+
f_aggregate(2);
+
}
+
/*! @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])
@}
+
*!
@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; {
-
INT32
e;
-
struct
array
*a;
-
-
DECLARE
_
CYCLIC();
-
-
/* Optimization */
-
if
(data
->refs
== 1)
-
{
-
/* An array with one ref cannot possibly be cyclic */
-
struct svalue sval;
-
data->type_field = BIT_MIXED | BIT_UNFINISHED;
-
for(e=0;e<data->size;e++)
-
{
-
index
_no_free(&sval
,
ITEM(data
)
+e, index)
;
-
free_svalue(ITEM(data)+e);
-
ITEM(data)[e]=sval;
+
RETURN
array_
column
(data
,
index,
1
);
}
-
pop_stack();
-
return;
-
}
+
-
if((a=(struct array *)BEGIN_CYCLIC(data,0)))
-
{
-
add_ref(a);
-
}else{
-
push_array(a=allocate_array(data->size));
-
SET_CYCLIC_RET(a);
-
-
for(e=0;e<a->size;e++)
-
index_no_free(ITEM(a)+e, ITEM(data)+e, index);
-
-
sp--;
-
}
-
END_CYCLIC();
-
RETURN a;
-
}
-
+
/*! @decl multiset mkmultiset(array a) *! *! This function creates a multiset from an array. *! *! @seealso *! @[aggregate_multiset()] *! */
-
+
PMOD_EXPORT
PIKEFUN multiset(1) mkmultiset(array(1=mixed) a) efun; optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND; { RETURN mkmultiset(a); }
-
/*! @decl int trace(int
t
)
+
/*! @decl int trace(int
level, void|string facility, void|int all_threads
)
*!
-
*! This function changes the
debug
trace level.
+
*! 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
.
*!
-
*! The
old
level is
returned
.
+
*!
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
.
*!
-
*! 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.
-
+
*!
+
*! @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.
*/
-
PIKEFUN int trace(int
t
)
+
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;
+
}
-
+
/*! @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,int,int:void) "destruct_cb"
+
*! This function is called once for each object that is part of
+
*! a cycle just before the gc will destruct it.
+
*! The arguments are:
+
*! @dl
+
*! @item
+
*! The object to be destructed.
+
*! @item
+
*! The reason for it being destructed. One of:
+
*! @int
+
*! @value Object.DESTRUCT_CLEANUP
+
*! Destructed during exit.
+
*! @value Object.DESTRUCT_GC
+
*! Destructed during normal implicit or explicit @[gc()].
+
*! @endint
+
*! @item
+
*! The number of references it had.
+
*! @enddl
+
*! @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()] */
-
PIKEFUN string ctime(
int
timestamp)
+
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
);
} /*! @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); }
-
+
/*! @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]
occurrs
-
*! in the string @[haystack].
+
*! 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); } /*! @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++) { \
pike.git/src/builtin.cmod:401:
} \ } 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;
+
}
+
+
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
+
}
+
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
and
carriage return) from the string @[s].
+
*! 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 DO_IT(TYPE)
\
+
+
#define DO_IT(TYPE
,CASE
) \
{ \
-
for (; start <
s->len
; start++) { \
+
for (; start <
end
; start++) {
\
chr = ((TYPE *) s->str)[start]; \
-
if
(chr
!=
'
'
&&
chr
!=
'\t'
&&
chr
!=
'\n'
&&
chr
!=
'\r')
\
-
break; \
+
switch
(chr
)
{
\
+
CASE \
+
continue; \
+
} \
+
break;
\
} \ while (--end > start) { \ chr = ((TYPE *) s->str)[end]; \
-
if
(chr
!=
'
'
&&
chr
!=
'\t'
&&
chr
!=
'\n'
&&
chr
!=
'\r')
\
-
break; \
+
switch
(chr
)
{
\
+
CASE \
+
continue; \
+
} \
+
break;
\
} \ }
-
case 0: DO_IT (p_wchar0); break;
-
case 1: DO_IT (p_wchar1); break;
-
case 2: DO_IT (p_wchar2); 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 } 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); }
-
/*! @decl int inherits(program child, program parent)
+
/*! @decl int inherits(program
|object
child, program parent)
*! @belongs Program *! *! Returns 1 if @[child] has inherited @[parent]. */
-
PIKEFUN int program_inherits(program
parent
, program
child
)
+
PMOD_EXPORT
+
PIKEFUN int program_inherits(program
|object
child
, program
parent
)
errname Program.inherits; optflags OPT_TRY_OPTIMIZE; {
-
RETURN low_get_storage(
parent
,
child
) != -1;
+
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;
} /*! @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
@tt{
"
@i{filename@}
:
@i{linenumber@}
"@}.
+
*! The returned string is of the format
@expr{
"
filename
:
linenumber
"@}.
*!
-
*! If it cannot be determined where the program was defined,
@tt{0@} (zero)
-
*! will be returned.
+
*! 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)
-
{
-
INT32
line;
-
struct pike_string *tmp = get_program_line(p, &line);
+
INT
_
TYPE
line;
+
struct pike_string *tmp =
low_
get_program_line(p, &line);
pop_n_elems(args);
-
+
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); } /*! @decl int(8..8)|int(16..16)|int(32..32) width(string s) *! @belongs String *! *! 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
+
*!
@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); } /*! @decl mixed m_delete(object|mapping map, mixed index) *! *! If @[map] is an object that implements @[lfun::_m_delete()],
-
*! that function will be called with @[index] as
the
signle
argument.
+
*! that function will be called with @[index] as
its
single
argument.
*!
-
*!
Other
wise
if @[map] is a mapping the entry with index @[index]
+
*!
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))
{
-
/*FIXME:
Should
be
-
*
type function(mapping(1=mixed:2=mixed),1:2)|
-
* function(object,mixed:mixed)
;
-
*
-
* or similar
-
*/
-
if( map
->type
== T_MAPPING )
+
struct
program
*
p
;
+
if(
TYPEOF(*
map
)
== T_MAPPING )
{ struct svalue 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 (map
->type
== T_OBJECT && map->u.object->prog)
+
else if (
TYPEOF(*
map
)
== T_OBJECT &&
(p =
map->u.object->prog)
)
{
-
int id = FIND_LFUN(
map
->
u
.
object->
prog, LFUN__M_DELETE);
+
int id = FIND_LFUN(
p
->
inherits[SUBTYPEOF(*map)]
.prog, LFUN__M_DELETE);
if( id == -1 )
-
SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object
with
_m_delete");
+
SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object
containing
the
_m_delete
method
");
-
apply_low(
map->u.object, id, 1
);
+
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; { 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 (m
->ind->flags
&
(ARRAY
_WEAK
_FLAG|ARRAY_WEAK_SHRINK)) ?
-
PIKE_WEAK_INDICES : 0
;
+
RETURN
multiset_get_flags
(m
)
&
MULTISET
_WEAK;
}
-
PIKEFUN program __empty_program()
+
/*! @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; {
-
RETURN
low_allocate_program();
+
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;
}
-
/*! @decl string function_name(function f)
+
/*
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
|program
f)
*!
-
*! Return the name of the function @[f].
+
*! Return the name of the function
or program
@[f].
*!
-
*! If @[f] is a global function defined in the runtime
@tt{0@} (zero)
-
*! will be returned.
+
*! 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; {
-
switch(func
->type
)
+
int f = -1;
+
struct program *p = NULL;
+
+
switch(
TYPEOF(*
func)
)
{ default:
-
if(!func->u.object->prog)
-
bad
_
arg
_
error
("function_name",
Pike_sp-args, args,
1,
-
"function|program"
, Pike_sp-args,
-
"Bad argument.\n"
);
+
SIMPLE
_
BAD
_
ARG_ERROR
("function_name", 1, "function|program");
return; /* NOTREACHED */ case PIKE_T_PROGRAM: {
-
struct program *
p=func->u.program;
+
p
=
func->u.program;
if(p->parent) { int e; p=p->parent; /* search constants in parent for this * program... */ for(e = p->num_identifier_references; e--; ) { struct identifier *id; if (p->identifier_references[e].id_flags & ID_HIDDEN) continue; id = ID_FROM_INT(p, e); if (IDENTIFIER_IS_CONSTANT(id->identifier_flags) &&
-
is_eq( & PROG_FROM_INT(p, e)->constants[id->func.offset].sval,
+
(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 PIKE_T_FUNCTION:
-
if(func
->subtype
== FUNCTION_BUILTIN) break;
-
if(!func->u.object->prog)
+
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(
func->u.object->prog
== pike_trampoline_program)
+
if(
p
== pike_trampoline_program)
{ struct pike_trampoline *t; t=((struct pike_trampoline *)func->u.object->storage);
-
if(t->frame->current_object->prog)
-
REF_RETURN
ID_FROM_INT(
t->frame->current_object->prog
,
-
t->func
)->name
;
+
+
if(t->frame->current_object->prog)
{
+
p
=
t->frame->current_object->prog
;
+
f
=
t->func;
}
-
+
}
-
REF
_RETURN ID_FROM_INT(
func->u.object->prog
,
func->subtype
)->name;
+
#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
|program
f)
+
/*! @decl object function_object(function f)
*!
-
*! Return the object the function @[f] is in.
+
*!
Return the object the function @[f] is in.
*!
-
*! If @[f] is a global function defined in the runtime
@tt{0@} (zero)
-
*! will be returned.
+
*!
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_name()]
, @[function_program()]
*/
-
PIKEFUN object
|program
function_object(
object
|program
|function
func)
+
PMOD_EXPORT
+
PIKEFUN object function_object(
function
|program func)
efun; optflags OPT_TRY_OPTIMIZE;
-
type function(function
|object
:object)
|function(program:program)
;
+
type function(function:object);
{
-
switch(func
->type
)
+
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;
-
}
+
break;
case PIKE_T_FUNCTION:
-
if(func
->subtype
== FUNCTION_BUILTIN) break;
+
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; }
-
func
->type=
T_OBJECT;
+
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
int
random
(
int
max
)
+
/*! @decl
program
function_program
(
function|program
f
)
*!
-
*!
This
function
returns
a random number in
the
range
0 -
@[
max
]
-1
.
+
*!
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
-
*! @[
random
_
seed
()]
+
*! @[
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("function_program", 1, "function");
+
}
+
pop_n_elems(args);
+
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()]
+
*/
+
+
PMOD_EXPORT
PIKEFUN mixed random(object o) efun; optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND; {
-
apply
(o,
"
_
random
",0);
+
int f = low_find_lfun
(o
->prog
,
LFUN
_
_RANDOM);
+
if (f < 0) {
+
Pike_error(
"
Calling undefined lfun::%s.\n"
,
lfun_names[LFUN__RANDOM]);
+
}
+
apply_low(o, f,
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(
!
m
->ind->size
)
+
if(
multiset_is_empty (
m)
)
SIMPLE_BAD_ARG_ERROR("random", 1, "multiset with elements in it");
-
push_
svalue
(m
->ind->item
+
(my_rand() % m
->ind->size
));
+
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(); }
-
PIKEFUN
mapping random(mapping m)
+
/*!
@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;
pike.git/src/builtin.cmod:805:
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;
+
PIKEVAR mixed
_
fun
flags ID_PROTECTED|ID_PRIVATE
;
+
#ifdef PIKE_DEBUG
+
PIKEVAR program oprog flags ID_PROTECTED|ID_PRIVATE;
+
#endif
PIKEVAR array args;
-
CVAR
struct
program
*prog; /*
FIXME:
Ought
to be
a
private
pikevar...
*/
-
CVAR
unsigned
char
*
pc;
+
+
/*
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->
fun.type
=
T_INT;
-
THIS->fun.u.integer = 0;
-
THIS->prog =
NULL;
-
THIS->
pc = 0;
-
THIS->
lineno =
0;
-
THIS
-
>args = NULL
;
+
THIS->
pc
= NULL;
+
THIS->lineno = -
1
;
THIS->filename = NULL; } EXIT
-
+
gc_trivial;
{
-
if (THIS->prog) {
-
free_program(THIS->prog);
-
THIS->prog = NULL;
-
}
-
if (THIS->args) {
-
free_array(THIS->args);
-
THIS->args = NULL;
-
}
+
if (THIS->filename) { free_string(THIS->filename); THIS->filename = NULL; } THIS->pc = NULL;
-
THIS->lineno =
0;
-
free_svalue(&THIS
-
>fun)
;
-
THIS->fun.type = T_INT;
-
THIS->fun.u.integer = 0;
+
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); }
-
PIKEFUN
string
_
sprintf
(
int c, mapping|void opts
)
+
static
void
fill
_
in_file_and_line
()
{
-
pop
_
n_elems
(
args
);
+
struct pike
_
string *file = NULL;
+
assert
(
THIS->lineno == -1
);
-
push_text("backtrace_frame(");
-
if (THIS->pc
)
{
-
if (!
THIS->
filename
) {
-
THIS->filename
= get_line(THIS->pc, THIS->prog, &THIS->lineno);
-
}
+
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 (THIS->fun
.type
== PIKE_T_FUNCTION) {
-
if (THIS->fun.u.object->prog) {
-
push_svalue(&THIS->fun);
+
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);
-
THIS->fun
.type
=
PIKE_T_INT
;
-
THIS->fun.u.
integer
=
0;
-
THIS->fun.subtype = NUMBER_DESTRUCTED;
+
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); }
-
PIKEFUN int _sizeof()
+
/*! @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; }
pike.git/src/builtin.cmod:945:
if (!end_or_none) { if (index < 0) { index_error("pike_frame->`[]", Pike_sp-args, args, NULL, Pike_sp-args, "Indexing with negative index (%"PRINTPIKEINT"d)\n", index); } else if (index >= numargs) { index_error("pike_frame->`[]", Pike_sp-args, args, NULL, Pike_sp-args, "Indexing with too large index (%"PRINTPIKEINT"d)\n", index); } } else {
-
if (end_or_none
->type
!= PIKE_T_INT) {
+
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);
pike.git/src/builtin.cmod:967:
} if (end >= numargs) { end = numargs-1; } } for (i = index; i <= end; i++) { switch(i) { case 0: /* Filename */
-
case
1:
/* Linenumber */
-
if (THIS->
pc) {
-
if (!THIS->filename) {
-
THIS->filename = get_line(THIS->pc, THIS->prog, &THIS->
lineno
);
-
}
-
THIS->pc
=
NULL;
-
}
-
if (THIS
-
>prog
)
{
-
free
_
program(THIS->prog);
-
THIS->prog = NULL;
-
}
-
if (i) {
-
/* Linenumber */
-
push
_
int
(
THIS->lineno
);
-
} else {
-
/* 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);
+
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->`[](): "
pike.git/src/builtin.cmod:1014:
} /* 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 %"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 */
-
case
1:
/* Linenumber */
-
/* First make sure we have line-number info. */
-
if (THIS->
pc) {
-
if (!THIS->filename) {
-
THIS->filename = get_line(THIS->pc, THIS->prog, &THIS->
lineno
);
-
}
-
THIS->pc
=
NULL;
-
}
-
if (THIS->prog) {
-
free_program(THIS->prog);
-
THIS->prog
=
NULL;
-
}
-
if (index) {
-
/* Linenumber */
-
if (value
-
>type != PIKE_T_INT
)
{
-
SIMPLE
_
BAD
_
ARG
_
ERROR("backtrace
_
frame->`[]=", 2, "int
(
1..
)
")
;
-
}
-
THIS->lineno = value->u.integer;
-
} else {
-
/* Filename */
-
if (value
->type
!= PIKE_T_STRING) {
-
if ((value
->type
!= PIKE_T_INT) ||
+
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 */
-
assign_svalue(&THIS->fun, value);
+
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 *i)
+
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--;
-
res->item[size]
.u.object
= o;
-
res->item[size].type =
PIKE_T_OBJECT
;
-
res->item[size].subtype = 0
;
+
SET_SVAL(
res->item[size]
,
PIKE_T_OBJECT
,
0,
object,
o)
;
bf = OBJ2_BACKTRACE_FRAME(o);
-
if ((bf->prog = f->context
.
prog)) {
+
if ((bf->prog = f->context
->
prog)) {
add_ref(bf->prog); bf->pc = f->pc; }
-
if
(
(
bf->fun
.u.object
=
f->current_object
)
&&
-
(
bf
->fun
.u.object->prog
)
)
{
-
add
_
ref
(
bf->fun
.
u
.
object);
-
bf->fun
.subtype
=
f->
fun
;
-
bf->fun.type
=
PIKE
_
T
_
FUNCTION
;
+
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 {
-
bf->fun
.u.integer
=
0
;
-
bf
->
fun.subtype
=
NUMBER
_
DESTRUCTED
;
-
bf->
fun.type
=
PIKE
_
T_INT
;
+
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,
-
i->
stack_
pointer
- f->locals));
-
if(of)
+
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 */
+
* 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);
-
if (numargs) {
-
bf->args = allocate_array_no_init(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
pike.git/src/builtin.cmod:1184:
*! @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
accomodate
for deferred backtraces.
+
*! (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); }
-
#define INITIAL_BUF_LEN 4096
-
+
/*! @module String */ /*! @class Buffer *! A buffer, used for building strings. It's *! conceptually similar to a string, but you can only @[add] *! strings to it, and you can only @[get] the value from it once. *! *! There is a reason for those seemingly rather odd limitations, *! it makes it possible to do some optimizations that really speed *! things up. *! *! You do not need to use this class unless you add very many *! strings together, or very large strings. *! *! @example *! For the fastest possible operation, write your code like this: *!
-
*!
@code{
-
*!
String.Buffer b = String.Buffer( );
+
*!
@code
+
*! String.Buffer b = String.Buffer( );
*!
-
*!
function add = b->add;
+
*! function add = b->add;
*!
-
*!
.. call add several times in code ...
+
*! .. call add several times in code ...
*!
-
*!
string result = b->get(); // also clears the buffer
-
*!
@}
+
*! string result = b->get(); // also clears the buffer
+
*!
@endcode
*/ PIKECLASS Buffer { CVAR struct string_builder str; CVAR int initial;
-
+
PIKEFUN int _size_object()
+
{
+
if( THIS->str.s )
+
RETURN THIS->str.malloced;
+
RETURN 0;
+
}
+
void f_Buffer_get_copy( INT32 args ); void f_Buffer_get( INT32 args ); void f_Buffer_add( INT32 args );
-
-
/*! @decl void create()
+
/*! @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(
args
)
+
if(
size
)
str->initial = MAXIMUM( size->u.integer, 512 ); else
-
{
+
str->initial = 256;
-
push_int(0);
+
}
-
}
+
-
+
/*! @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_
int
(
0
);
-
Pike_sp[-1].subtype = 1;
+
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_
CONSTANT
_
SHARED_
STRING( string_t, "string" );
-
MAKE_
CONSTANT
_
SHARED_
STRING( int_t, "int" );
+
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; }
pike.git/src/builtin.cmod:1334:
{ struct Buffer_struct *str = THIS; pop_stack(); if( Pike_fp->current_object->refs != 1 ) f_Buffer_get_copy( 0 ); else f_Buffer_get( 0 ); o_cast_to_int( ); return; }
-
Pike_error("Cannot cast to %
s\n
", type
->str
);
+
Pike_error("Cannot cast to %
S\n
", type);
}
-
PIKEFUN object `+( string what )
+
/*! @decl String.Buffer `+( string|String.Buffer what )
+
*/
+
PIKEFUN object `+( string
|Buffer
what )
+
rawtype tFunc(tOr(tString, tObjIs_BUFFER), tObjIs_BUFFER);
{ struct Buffer_struct *str = THIS, *str2;
-
struct object *res = clone_object( Buffer_program
,
0
);
-
-
if( str->str.s )
-
{
+
struct object *res =
fast_
clone_object( Buffer_program );
str2 = OBJ2_BUFFER( res );
-
-
if(
str2->
str.s
)
free_string_builder( &str2
->
str )
;
-
*str2 = *str;
-
init_string_builder_alloc
(
&str2->
str
,
-
str
->str.
malloced,
-
str->str.
s
->size_shift
)
;
-
MEMCPY(
(
void *)
str2->str
.s
,
(void *)
str->str
.s,
-
str->str.malloced+sizeof(struct pike_string
)
)
;
-
}
+
str2->
initial
=
str
->
initial
;
+
if
( str->str.s )
+
init_string_builder_copy
(
&
str2->str,
&
str->str);
apply( res, "add", 1 ); RETURN res; }
-
PIKEFUN object `+=( string what )
+
/*! @decl String.Buffer `+=( string|String.Buffer what )
+
*/
+
PIKEFUN object `+=( string
|Buffer
what )
+
rawtype tFunc(tOr(tString, tObjIs_BUFFER), tObjIs_BUFFER);
{ f_Buffer_add( 1 );
-
REF_RETURN fp->current_object;
+
REF_RETURN
Pike_
fp->current_object;
}
-
/*! @decl
void
add(string ... data)
+
/*! @decl
int
add(string
|String.Buffer
... data)
*!
-
*! Adds @[data] to the buffer.
Returns the size of the buffer.
+
*! Adds @[data] to the buffer.
*!
-
+
*! @returns
+
*! Returns the size of the buffer.
+
*!
+
*! @note
+
*! Pike 7.8 and earlier did not support adding @[String.Buffer]s
+
*! directly.
+
*!
+
*! @seealso
+
*! @[addat()]
*/
-
PIKEFUN int add( string ... arg1 )
+
PIKEFUN int add( string
|Buffer
... arg1 )
+
rawtype tFuncV(tNone, tOr(tString, tObjIs_BUFFER), tIntPos);
{ struct Buffer_struct *str = THIS;
-
int j;
+
int
init_from_arg0 = 0,
j;
-
+
for (j=0; j < args; j++) {
+
if (TYPEOF(Pike_sp[j-args]) == PIKE_T_STRING) {
+
} else if ((TYPEOF(Pike_sp[j-args]) != PIKE_T_OBJECT) ||
+
(Pike_sp[j-args].u.object->prog != Buffer_program)) {
+
SIMPLE_BAD_ARG_ERROR("add", j+1, "string|String.Buffer");
+
}
+
}
+
if (!str->str.s && args) {
-
int
sum = 0;
+
ptrdiff_t
sum = 0;
int shift = 0; for (j=0; j < args; j++) {
-
struct pike_string *a = Pike_sp[j-args].u.string;
+
struct pike_string *a
;
+
if (TYPEOF(Pike_sp[j-args])
=
=
PIKE_T_STRING) {
+
a =
Pike_sp[j-args].u.string;
+
} else {
+
a = OBJ2_BUFFER(Pike_sp[j-args].u.object)->str.s;
+
if (!a) continue;
+
}
sum += a->len; shift |= a->size_shift; }
-
if (sum < str->initial)
{
+
if (sum < str->initial)
sum = str->initial;
-
+
else if (sum > str->initial)
+
sum <<= 1;
+
shift = shift & ~(shift >> 1);
+
+
if ((TYPEOF(Pike_sp[-args]) == PIKE_T_STRING) &&
+
(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;
}
-
init_string_builder_alloc(&str->str, sum, shift
&
~(shift
>
>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 =
0
; j<args; j++ )
+
for( j =
init_from_arg0
; j<args; j++ )
{
-
struct pike_string *a = Pike_sp[j-args].u.string;
+
struct pike_string *a
;
+
if (TYPEOF(Pike_sp[j-args])
=
=
PIKE_T_STRING) {
+
a =
Pike_sp[j-args].u.string;
+
} else {
+
a = OBJ2_BUFFER(Pike_sp[j-args].u.object)->str.s;
+
if (!a) continue;
+
}
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|String.Buffer ... 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 will be padded
+
*! with NUL-characters.
+
*!
+
*! @note
+
*! Pike 7.8 and earlier did not support adding @[String.Buffer]s
+
*! directly.
+
*!
+
*! @seealso
+
*! @[add()]
+
*/
+
PIKEFUN int addat(int(0..) pos, string ... arg1 )
+
rawtype tFuncV(tNone, tOr(tString, tObjIs_BUFFER), tIntPos);
+
{
+
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;
+
if (TYPEOF(Pike_sp[j-args]) == PIKE_T_STRING) {
+
a = Pike_sp[j-args].u.string;
+
} else if ((TYPEOF(Pike_sp[j-args]) != PIKE_T_OBJECT) ||
+
(Pike_sp[j-args].u.object->prog != Buffer_program)) {
+
SIMPLE_BAD_ARG_ERROR("addat", j+1, "string|String.Buffer");
+
} else {
+
a = OBJ2_BUFFER(Pike_sp[j-args].u.object)->str.s;
+
if (!a) continue;
+
}
+
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;
+
if (TYPEOF(Pike_sp[j-args]) == PIKE_T_STRING) {
+
a = Pike_sp[j-args].u.string;
+
} else {
+
a = OBJ2_BUFFER(Pike_sp[j-args].u.object)->str.s;
+
if (!a) continue;
+
}
+
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.
-
+
*!
+
*! @seealso
+
*! @[get()]
*/ 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_
string
(d,len);
+
RETURN make_shared_binary_
string0
(
(p_wchar0 *)
d,len);
break; case 1:
-
RETURN make_shared_binary_string1((
short
*)d,len
>>1
);
+
RETURN make_shared_binary_string1((
p_wchar1
*)d,len);
break; case 2:
-
RETURN make_shared_binary_string2((
int
*)d,len
>>2
);
+
RETURN make_shared_binary_string2((
p_wchar2
*)d,len);
break; } } }
-
push_
text
(
""
);
+
push_
empty_string
();
return; } /*! @decl string get() *! *! Get the data from the buffer. *! *! @note *! This will clear the data in the buffer
-
+
*!
+
*! @seealso
+
*! @[get_copy()], @[clear()]
*/ 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 =
0
;
+
str->str.s =
NULL
;
RETURN s; } pop_n_elems(args);
-
push_
text
(
""
);
+
push_
empty_string
();
return; }
-
+
/*! @decl void clear()
+
*!
+
*! Empty the buffer, and don't care about the old content.
+
*!
+
*! @note
+
*! This function was not available in Pike 7.8 and earlier.
+
*!
+
*! @seealso
+
*! @[get()]
+
*/
+
PIKEFUN void clear()
+
{
+
/* FIXME: Support resetting the initial size? */
+
struct Buffer_struct *str = THIS;
+
if (str->str.s) {
+
/* FIXME: There's also the alternative of using
+
* reset_string_builder() here.
+
*/
+
free_string_builder(&str->str);
+
str->str.s = NULL;
+
}
+
}
+
/*! @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
tupel
-
{
-
int prefix
;
-
struct
pike_string
*ind;
-
struct
pike
_
string
*val;
-
}
*
v;
-
CVAR
size_t
v_sz;
-
CVAR size
_
t sz
;
-
CVAR
INT32
set_start[256];
-
CVAR INT32 set
_
end[256]
;
+
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
;
-
static
int
replace
_
sortfun
(
struct tupel *a,struct tupel *b
)
+
PIKEFUN
int _
size_object
()
{
-
return
DO
_
NOT
_
WARN
(
(int
)
my
_
quick
_
strcmp(a
->ind,
b
->
ind
)
)
;
+
int res = 0, i;
+
if( THIS->ctx.v )
+
{
+
struct svalue tmp;
+
tmp.type = PIKE
_
T
_
STRING;
+
for
(
i=0; i<THIS->ctx.num; i++ )
+
{
+
res += sizeof
(
struct replace
_
many
_
tupel);
+
tmp.u.string = THIS
->
ctx.v[i].
ind
;
+
res += rec_size_svalue( &tmp
,
NULL );
+
tmp.u.string = THIS
->
ctx.v[i].val;
+
res += rec_size_svalue( &tmp, NULL
);
}
-
+
}
-
PIKEFUN void create(array(string)|void from_, array(string)|void to_)
+
RETURN res;
+
}
+
+
/*! @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
)
{
-
int
i;
-
struct
array
*
from;
-
struct
array
*
to;
+
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_
||
!
to_) {
+
if (from_
arg
&&
TYPEOF(*from_arg) == T_MAPPING) {
+
if (
to_
arg
) {
Pike_error("Bad number of arguments to create().\n"); }
-
from = from_->u.
array
;
-
to =
to
_->u.
array
;
-
if
(from-
>size
!
=
to
->size
) {
-
Pike_error("
Replace
must
have
equal-sized
from and
to
arrays
.\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");
}
-
for
(
i
=
0;
i
<
(int)from->size;
i++)
{
-
if (from
->item[i].type
!=
PIKE_
T_
STRING
) {
-
Pike
_
error
("Replace
:
from
array
is
not
an
array(string)
.\n
");
+
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 (to
->item[i].type
!
=
PIKE_
T_STRING) {
-
Pike
_
error
(
"Replace:
to
array
is
not
an
array
(
string
)
.\n"
);
+
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 (
THIS
->
v) {
-
for (i = 0; i < (int)THIS
->
v_sz;
i++) {
-
if (
!
THIS->v[i].ind)
break;
-
free
_
string(THIS
->
v[i]
.
ind);
-
THIS
->
v[i].ind
= NULL;
-
free
_
string
(
THIS->v[i].val);
-
THIS->v[i]
.
val = NULL
;
+
if (
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->v && (THIS->v_sz < (size_t)from->size)) {
-
free(THIS->v);
-
THIS->v = NULL;
-
THIS->v_sz = 0;
-
}
-
if (!THIS->v) {
-
THIS->v = (struct tupel *)xalloc(sizeof(struct tupel) * from->size);
-
THIS->v_sz = from->size;
-
}
-
for (i = 0; i < (int)from->size; i++) {
-
copy_shared_string(THIS->v[i].ind, from->item[i].u.string);
-
copy_shared_string(THIS->v[i].val, to->item[i].u.string);
-
THIS->v[i].prefix = -2; /* Uninitialized */
-
}
-
THIS->sz = from->size;
-
fsort((char *)THIS->v, from->size, sizeof(struct tupel),
-
(fsortfun)replace_sortfun);
+
-
MEMSET(THIS->set_start,
0, sizeof
(
INT32)*256);
-
MEMSET(
THIS->
set_end, 0, sizeof(INT32)*256);
-
-
for (i = 0; i < (int)
from->size
; i++
) {
-
INT32
x
= index_shared_string(THIS
-
>v[from->size-1-i].ind,
0);
-
if ((x >= 0) && (x < 256))
-
THIS->set_start[x] = from->size-1-i;
-
x = index_shared_string(THIS->v[i]
.
ind,
0);
-
if ((x >= 0) && (x < 256))
-
THIS->set_end[x] = i+1;
-
}
+
if
(
!
THIS->from->size) {
+
/*
Enter
no
-
op
mode
.
*/
pop_n_elems(args); push_int(0);
-
+
return;
}
-
static
int
find_longest_prefix
(
char
*str,
-
ptrdiff
_
t
len,
-
int size
_
shift
,
-
struct tupel *v
,
-
INT32 a,
-
INT32 b
)
-
{
-
INT32 c,match=-1
;
-
ptrdiff_t tmp;
+
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)")
;
-
while
(
a<b
)
-
{
-
c=
(
a+b)/
2;
+
if
(
(THIS->to->type_field & ~BIT_STRING
)
&&
+
(array_fix_type_field(THIS->to) & ~BIT_STRING) )
+
SIMPLE_BAD_ARG_ERROR
(
"Replace", 2, "array(string
)
|string")
;
-
tmp=generic
_
quick
_
binary_strcmp
(
v[c].ind
->
str
,
-
v[c].ind
->
len
,
-
v[c].ind
->
size_shift
,
-
str,
-
MINIMUM(len,v[c].ind->len),
-
size_shift);
-
if(tmp<0)
-
{
-
INT32 match2=find_longest_prefix(str,
-
len,
-
size_shift,
-
v,
-
c+1,
-
b);
-
if(match2!=-
1)
return match2
;
+
compile
_
replace
_
many
(
&THIS
->
ctx
,
THIS
->
from
,
THIS
->
to
, 1);
-
while(1)
-
{
-
if(v[c].prefix==-2)
-
{
-
v[c].prefix=find
_
longest
_
prefix
(
v[c].ind->str,
-
v[c].ind->len,
-
v[c].ind->size
_
shift,
-
v,
-
0
/* can this be optimized? */,
-
c
);
+
pop_n_elems
(
args
)
;
+
push
_
int
(0);
}
-
c=v[c].prefix;
-
if(c<a || c<match) return match;
+
-
if
(
!generic_quick_binary_strcmp
(
v[c].ind->str,
-
v[c].ind->len,
-
v[c].ind->size_shift,
-
str
,
-
MINIMUM(len,v[c].ind->len
)
,
-
size_shift))
-
return c;
-
}
-
}
-
else if(tmp>0)
-
{
-
b=c;
-
}
-
else
-
{
-
a=c+1; /
*
There might still be a better match... *
/
-
match=c;
-
}
-
}
-
return match;
-
}
-
+
/*!
@decl
string
`
(
)
(
string
str)
+
*/
PIKEFUN string `()(string str) {
-
struct
string_builder ret;
-
ptrdiff_t length = str->len;
-
ptrdiff_t s;
-
int *set_start =
THIS->
set_start;
-
int *set_end = THIS->set_end;
-
struct
tupel
*
v
=
THIS->v;
-
int
num
=
THIS->sz;
-
-
if (!num) {
-
add_ref(str)
;
-
RETURN str;
+
if
(!
THIS->
ctx.v)
{
+
/
*
The
result
is
already
on
the
stack
in
the
correct
place...
*/
+
return
;
}
-
init_string_builder(&ret,str->size_shift);
-
-
for(s=0;length > 0;)
-
{
-
INT32 a,b;
-
ptrdiff
_
t ch;
-
-
ch = index
_
shared_string
(
str, s);
-
if((ch >= 0)
&
& (ch < 256))
-
b = set_end[ch];
-
else
-
b = num;
-
-
if(b)
-
{
-
if((ch >= 0) && (ch < 256))
-
a = set_start[ch];
-
else
-
a = 0;
-
-
a = find_longest_prefix(str
->
str+(s << str->size_shift)
,
-
length,
-
str
->size_shift,
-
v, a, b
);
-
-
if(a!=-1)
-
{
-
ch = v[a].ind->len;
-
if(!ch) ch=1;
-
s += ch;
-
length -= ch;
-
string_builder_shared_strcat(&ret, v[a].val);
-
continue;
+
RETURN
execute
_
replace
_
many
(&
THIS
->
ctx
, str);
}
-
}
-
string_builder_putchar(&ret,
-
DO_NOT_WARN((INT32)ch));
-
s++;
-
length--;
-
}
+
-
RETURN
finish
_
string_builder
(
&ret
)
;
-
}
-
-
PIKEFUN array(string) _encode()
+
/*!
@decl
array(array(string))
_
encode
()
+
*/
+
PIKEFUN array(
array(
string)
)
_encode()
{
-
size_t
i;
-
for
(i=0;
i <
THIS->
sz
;
i++)
{
-
ref_
push_
string
(
THIS->v[i].ind
);
+
if
(THIS->from) {
+
ref_push_array
(THIS->
from)
;
+
} else
{
+
push_
undefined
();
}
-
f_aggregate
(
DO_NOT_WARN((INT32)
THIS->
sz
)
);
-
for
(i=0;
i <
THIS->
sz
;
i++)
{
-
ref_
push_
string
(
THIS->v[i].val
);
+
if
(THIS->
to
)
{
+
ref_push_array
(THIS->
to)
;
+
} else
{
+
push_
undefined
();
}
-
f_aggregate(DO_NOT_WARN((INT32)THIS->sz));
+
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 {
-
THIS->
v
=
NULL;
-
THIS->v
_
sz = 0
;
-
THIS->sz = 0;
+
MEMSET(&
THIS->
ctx,
0,
sizeof(struct
replace
_
many_context))
;
} EXIT
-
+
gc_trivial;
{
-
if (THIS->v) {
-
int i;
-
for (i = 0; i < (int)THIS->v_sz; i++) {
-
if (!THIS->v[i].ind) break;
-
free_
string(THIS->v[i].ind);
-
THIS->v[i].ind = NULL;
-
free
_
string
(THIS->
v[i].val
);
-
THIS->v[i].val = NULL;
+
free_
replace
_
many_context
(
&
THIS->
ctx
);
}
-
free(THIS->v);
+
}
-
THIS->v = NULL;
-
THIS->v_sz = 0;
-
THIS->sz = 0;
-
}
-
}
+
/*! @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;
-
CVAR
struct pike_
string
*
del;
-
CVAR
struct pike_
string
*
to;
+
PIKEVAR
string del
flags ID_PROTECTED|ID_PRIVATE
;
+
PIKEVAR
string to
flags ID_PROTECTED|ID_PRIVATE
;
-
INIT
+
EXTRA
{
-
THIS->mojt.vtab
=
NULL;
-
THIS->mojt.data
=
NULL;
-
THIS->del
=
NULL;
-
THIS->to
=
NULL
;
+
MAP_VARIABLE
("o",
tObj, ID_PROTECTED|ID_PRIVATE,
+
single_string_replace_storage_offset +
+
OFFSETOF (single_string_replace_struct, mojt.container),
+
T_OBJECT)
;
}
-
EXIT
+
/*! @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->mojt.vtab) {
-
THIS->mojt.vtab->freeme(THIS->mojt.data);
-
THIS->mojt.vtab = NULL;
-
THIS->mojt.data = NULL;
-
}
+
if (THIS->del) { free_string(THIS->del); THIS->del = NULL; } if (THIS->to) { free_string(THIS->to); THIS->to = NULL; }
-
}
+
-
PIKEFUN
void
create(string|void
del
_, string|void to_
)
-
{
-
struct pike_string *del
;
-
struct pike_string *to;
+
if
(
!
del)
return
;
-
/* Clean up... */
-
exit_single_string_replace_struct();
-
-
if (!
del_) return;
-
-
if (!
to
_
) {
+
if (!to) {
SIMPLE_BAD_ARG_ERROR("String.SingleReplace->create", 2, "string"); }
-
if (del
_->u.string
== to
_->u.string
) {
+
if (del == to) {
/* No-op... */ return; }
-
copy_shared_string(THIS->del, del
= del_->u.string
);
-
copy_shared_string(THIS->to, to
= to_->u.string
);
+
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;
pike.git/src/builtin.cmod:1851:
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: fatal("Illegal shift.\n");
+
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;
pike.git/src/builtin.cmod:1885:
(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)
-
fatal("
generic_memory_search
found a match beyond end of string!\n");
+
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 (encoded_
->type
== PIKE_T_ARRAY) {
+
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
+
*/
+
+
+
/*! @module Builtin
+
*/
+
+
/*! @class automap_marker
+
*!
+
*! This is an internal class used by @[__automap__()].
+
*!
+
*! It may show up during module dumping or in backtraces
+
*! and the like.
+
*!
+
*! It should in normal circumstances never be used directly.
+
*!
+
*! @seealso
+
*! @[__automap__()], @[map()]
+
*/
PIKECLASS automap_marker { PIKEVAR array arg; PIKEVAR int depth;
-
+
/*! @decl void create(array arr, int depth)
+
*!
+
*! @param arr
+
*! Array that @[__automap__()] is to loop over.
+
*!
+
*! @param depth
+
*! Recursion depth of @[arr] where the loop will be.
+
*/
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); } }
-
+
/*! @endclass
+
*/
-
+
/*! @endmodule
+
*/
+
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(real_args[e]
.type
==T_OBJECT &&
+
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(tmpargs[e]
.type
!= T_ARRAY)
-
fatal
("
Arg
in
automap
is
not
array
!
\n");
-
#endif
+
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)
-
fatal
("No automap markers found in
low
_
automap\n
");
-
#endif
+
Pike_error
("No automap markers found in _
_automap__\n
");
push_array(ret=allocate_array(size));
-
+
types = 0;
for(x=0;x<size;x++) { for(e=0;e<args;e++) {
-
if(real_args[e]
.type
==T_OBJECT &&
+
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)
-
fatal("low_automap failed to determine size!\n");
+
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);
-
ITEM(ret)[x]
=*--Pike_sp
;
+
stack_pop_to_no_free (
ITEM(ret)
+ x);
+
types |= 1 << TYPEOF(ITEM(ret)
[x]
)
;
}
-
+
ret->type_field = types;
stack_unlink(args); }
-
+
/*! @decl array __automap__(function fun, mixed ... args)
+
*!
+
*! Automap execution function.
+
*!
+
*! @param fun
+
*! Function to call for each of the mapped arguments.
+
*!
+
*! @param args
+
*! Arguments for @[fun]. Either
+
*! @mixed
+
*! @type Builtin.automap_marker
+
*! Wrapper for an array to loop over. All of the
+
*! arrays will be looped over in parallel.
+
*! @type mixed
+
*! All other arguments will be held constant during
+
*! the automap, and sent as is to @[fun].
+
*! @endmixed
+
*!
+
*! @note
+
*! This function is used by the compiler to implement the
+
*! automap syntax, and should in normal circumstances never
+
*! be used directly.
+
*!
+
*! It may however show up during module dumping and in
+
*! backtraces.
+
*!
+
*! @note
+
*! It is an error not to have any @[Builtin.automap_marker]s
+
*! in @[args].
+
*!
+
*! @seealso
+
*! @[Builtin.automap_marker], @[map()]
+
*/
PIKEFUN array __automap__(mixed fun, mixed ... tmpargs) efun; { int e,depth=-1; check_stack(args); for(e=0;e<args-1;e++) {
-
if(tmpargs[e]
.type
==T_OBJECT &&
+
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); }
-
+
/*! @module Builtin
+
*/
+
+
/*! @class Setter
+
*!
+
*! Internal class for implementing setters.
+
*!
+
*! This class is used by @[_get_setter()].
+
*!
+
*! @seealso
+
*! @[_get_setter()]
+
*/
+
PIKECLASS Setter
+
{
+
PIKEVAR object o
+
flags ID_PROTECTED|ID_PRIVATE|ID_LOCAL;
+
CVAR int f;
+
+
/*! @decl void `()(mixed val)
+
*!
+
*! Set the variable for the setter to @[val].
+
*!
+
*! This is the function returned by @[_get_setter()].
+
*/
+
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);
+
}
+
}
+
+
/*! @endclass
+
*/
+
+
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 varname)
+
*!
+
*! Get a setter for the variable named @[varname] in object @[o].
+
*!
+
*! @returns
+
*! Returns a @[Setter()->`()()] for the variable if it exists,
+
*! and @expr{UNDEFINED@} otherwise.
+
*!
+
*! @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);
+
}
+
+
/*! @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(...)
+
{
+
pop_n_elems(args);
+
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 true 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) ||
+
(id->run_time_type == PIKE_T_GET_SET)) {
+
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, which
+
*! in turn will call @[serializer] with the arguments:
+
*! @dl
+
*! @item Argument 1
+
*! The value of the variable.
+
*! @item Argument 2
+
*! The name of the variable.
+
*! @item Argument 3
+
*! The declared type of the variable.
+
*! @enddl
+
*!
+
*! @note
+
*! The symbols will be listed in the order they were defined
+
*! in the class.
+
*!
+
*! @note
+
*! This function is typically called via @[Serializer.serialize()].
+
*!
+
*! @seealso
+
*! @[Serializer.serialize()], @[_serialize_variable()],
+
*! @[_deserialize()]
+
*/
+
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()], @[Builtin.Setter]
+
*/
+
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, which
+
*! in turn will call @[deserializer] with the arguments:
+
*! @dl
+
*! @item Argument 1
+
*! The setter for the variable.
+
*! @item Argument 2
+
*! The name of the variable.
+
*! @item Argument 3
+
*! The declared type of the variable.
+
*! @enddl
+
*!
+
*! @note
+
*! The symbols will be listed in the order they were defined
+
*! in the class.
+
*!
+
*! @note
+
*! This function is typically called via @[Serializer.deserialize()].
+
*!
+
*! @seealso
+
*! @[Serializer.deserialize()], @[_deserialize_variable()],
+
*! @[_serialize()], @[Builtin.Setter]
+
*/
+
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
+
*/
+
+
/* 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);
+
}
+
+
/*! @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.
+
*/
+
+
+
PIKEFUN int _size_object()
+
{
+
int q = THIS->num_elems;
+
int res = q * sizeof(struct pike_list_node);
+
struct mapping *m = NULL;
+
struct pike_list_node *n = THIS->head;
+
while( q-- )
+
{
+
res += rec_size_svalue( &n->val, &m );
+
n = n->next;
+
}
+
if( m ) free_mapping( m );
+
RETURN res;
+
}
+
+
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
}