e576bb2002-10-11Martin Nilsson /* -*- c -*- || This file is part of Pike. For copyright information see COPYRIGHT. || Pike is distributed under GPL, LGPL and MPL. See the file COPYING || for more information. */
c3da7f2000-07-04Martin Stjernholm 
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) #include "global.h" #include "interpret.h" #include "svalue.h" #include "pike_macros.h" #include "object.h" #include "program.h" #include "array.h"
bb8a782000-12-01Fredrik Hübinette (Hubbe) #include "pike_error.h"
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) #include "constants.h" #include "mapping.h" #include "stralloc.h" #include "multiset.h" #include "pike_types.h" #include "pike_memory.h" #include "threads.h" #include "module_support.h" #include "cyclic.h" #include "bignum.h"
098c802000-05-24Fredrik Hübinette (Hubbe) #include "main.h"
b8c5b22000-05-25Fredrik Hübinette (Hubbe) #include "operators.h"
9da7f42001-06-05Martin Stjernholm #include "builtin_functions.h"
fed7de2001-06-28Henrik Grubbström (Grubba) #include "fsort.h"
51adb82003-01-12Martin Stjernholm #include "gc.h"
d476592013-06-12Arne Goedeke #include "block_allocator.h"
c0d3772006-03-30Henrik Grubbström (Grubba) #include "pikecode.h"
f1d1aa2012-07-13Henrik Grubbström (Grubba) #include "opcodes.h"
a215142014-02-16Martin Nilsson #include "whitespace.h"
e950862014-08-29Stephen R. van den Berg #include "fdlib.h" #include "modules/_Stdio/file_machine.h" #include "modules/_Stdio/file.h"
6c15cb2008-06-10Martin Stjernholm  #include <ctype.h> #include <errno.h> #include <math.h>
9623712014-08-27Per Hedbor #include <arpa/inet.h>
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) 
a980cf2014-09-10Henrik Grubbström (Grubba) #define DEFAULT_CMOD_STORAGE
56c0642008-07-31Martin Stjernholm DECLARATIONS
12327f2013-05-22Per Hedbor  /*! @module System */ /*! @class TM *! A wrapper for the system struct tm time keeping structure. *! This can be used as a (very) lightweight alternative to Calendar. */
3c7f172013-11-17Henrik Grubbström (Grubba) PIKECLASS TM
12327f2013-05-22Per Hedbor { 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
09b6e22013-07-08Henrik Grubbström (Grubba) #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)
12327f2013-05-22Per Hedbor #endif #define strftime_zone strftime #define mktime_zone mktime #define strptime_zone strptime #define asctime_zone asctime #define localtime_zone(X,Y) localtime(X) #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)
379f922013-05-27Per Hedbor #ifdef HAVE_STRPTIME
670cfc2013-11-17Henrik Grubbström (Grubba)  /*! @decl int(0..1) strptime( string(1..255) format, string(1..255) data )
12327f2013-05-22Per Hedbor  *! *! Parse the given @[data] using the format in @[format] as a date. *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @dl *! @item %% *! The % character.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %a or %A *! The weekday name according to the C locale, in abbreviated *! form or the full name.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %b or %B or %h *! The month name according to the C locale, in abbreviated form *! or the full name.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %c *! The date and time representation for the C locale.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %C *! The century number (0-99).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %d or %e *! The day of month (1-31).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %D *! Equivalent to %m/%d/%y.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %H *! The hour (0-23).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %I *! The hour on a 12-hour clock (1-12).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %j *! The day number in the year (1-366).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %m *! The month number (1-12).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %M *! The minute (0-59).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %n *! Arbitrary whitespace.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %p *! The C locale's equivalent of AM or PM.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %R *! Equivalent to %H:%M.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %S *! The second (0-60; 60 may occur for leap seconds; *! earlier also 61 was allowed).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %t *! Arbitrary whitespace.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %T *! Equivalent to %H:%M:%S.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %U *! The week number with Sunday the first day of the week (0-53).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %w *! The weekday number (0-6) with Sunday = 0.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %W *! The week number with Monday the first day of the week (0-53).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %x *! The date, using the C locale's date format.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %X *! The time, using the C locale's time format.
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @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).
12327f2013-05-22Per Hedbor  *!
6bd26d2013-11-17Henrik Grubbström (Grubba)  *! @item %Y *! The year, including century (for example, 1991). *! @enddl
12327f2013-05-22Per Hedbor  *! */ 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; }
4907f62014-09-04Martin Nilsson #endif /* HAVE_STRPTIME */
6bd26d2013-11-17Henrik Grubbström (Grubba)  /*! @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 */
12327f2013-05-22Per Hedbor  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 ); }
670cfc2013-11-17Henrik Grubbström (Grubba)  /*! @decl int(0..60) sec;
12327f2013-05-22Per Hedbor  *! @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; }
7a74cc2014-08-26Per Hedbor  PIKEFUN int `year() { FIX_THIS();RETURN THIS->t.tm_year+1900; }
12327f2013-05-22Per Hedbor  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
5dfbb42013-12-07Arne Goedeke  push_undefined();
12327f2013-05-22Per Hedbor  } } 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");
09b6e22013-07-08Henrik Grubbström (Grubba)  if( GET_ZONE(&(THIS->t)) )
12327f2013-05-22Per Hedbor  { push_text(" ");
09b6e22013-07-08Henrik Grubbström (Grubba)  push_text( GET_ZONE(&(THIS->t)) );
12327f2013-05-22Per Hedbor  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); } }
7a74cc2014-08-26Per Hedbor  /*! @decl int|string cast(string to) *! *! Casted to an integer @[unix_time] will be returned. *! *! Casting to a string will call @[asctime]. */ PIKEFUN int|string cast( string to )
68ec3f2014-08-18Martin Nilsson  flags ID_PROTECTED;
12327f2013-05-22Per Hedbor  {
68ec3f2014-08-18Martin Nilsson  if( to == literal_int_string )
12327f2013-05-22Per Hedbor  { f_TM_unix_time(0); return; }
68ec3f2014-08-18Martin Nilsson  if( to == literal_string_string )
12327f2013-05-22Per Hedbor  { f_TM_asctime(0); return;
68ec3f2014-08-18Martin Nilsson  } pop_stack(); push_undefined();
12327f2013-05-22Per Hedbor  } /*! @decl string zone *! *! The timezone of this structure */ PIKEFUN string `zone() { FIX_THIS();
09b6e22013-07-08Henrik Grubbström (Grubba)  if( GET_ZONE(&(THIS->t)) ) push_text( GET_ZONE(&(THIS->t)) );
12327f2013-05-22Per Hedbor  else push_undefined(); } /*! @decl int gmtoff *! The offset from GMT for the time in this tm-struct */ PIKEFUN int `gmtoff() { FIX_THIS();
09b6e22013-07-08Henrik Grubbström (Grubba)  push_int( GET_GMTOFF(&(THIS->t)) );
12327f2013-05-22Per Hedbor  } /* 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. */
09b6e22013-07-08Henrik Grubbström (Grubba)  SET_GMTOFF(res, GET_GMTOFF(&(THIS->t))); SET_ZONE(res, GET_ZONE(&(THIS->t)));
12327f2013-05-22Per Hedbor  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; }
8e94242013-05-28Henrik Grubbström (Grubba)  /*! @decl void create(int t) *! Create a new @[TM] initialized from a unix time_t.
12327f2013-05-22Per Hedbor  *! 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"); }
8e94242013-05-28Henrik Grubbström (Grubba)  /*! @decl void create() *! Construct a new TM, all fields will be set to 0. */
12327f2013-05-22Per Hedbor  PIKEFUN void create( ) { memset( &THIS->t, 0, sizeof( struct tm ) ); THIS->t.tm_isdst = -1; THIS->unix_time = 0; THIS->modified = 1; }
8e94242013-05-28Henrik Grubbström (Grubba)  /*! @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.
12327f2013-05-22Per Hedbor  *! 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;
8e94242013-05-28Henrik Grubbström (Grubba)  t->tm_year = year - 1900;
12327f2013-05-22Per Hedbor  t->tm_mon = mon; t->tm_mday = mday; t->tm_hour = hour; t->tm_min = min; t->tm_sec = sec;
8e94242013-05-28Henrik Grubbström (Grubba)  if (THIS->set_zone) { free_string(THIS->set_zone); THIS->set_zone = NULL; }
12327f2013-05-22Per Hedbor  if( !timezone ) /* gmtime. */
09b6e22013-07-08Henrik Grubbström (Grubba)  SET_ZONE(t, "UTC");
12327f2013-05-22Per Hedbor  else {
8e94242013-05-28Henrik Grubbström (Grubba)  add_ref(timezone);
12327f2013-05-22Per Hedbor  THIS->set_zone = timezone;
09b6e22013-07-08Henrik Grubbström (Grubba)  SET_ZONE(t, timezone->str);
12327f2013-05-22Per Hedbor  } THIS->unix_time = mktime_zone( t ); } INIT { THIS->set_zone = 0; THIS->modified = 0; } EXIT { if( THIS->set_zone ) free_string( THIS->set_zone ); } }
e7afd92013-11-17Henrik Grubbström (Grubba) /*! @endclass */
12327f2013-05-22Per Hedbor #undef FIX_THIS #ifdef STRUCT_TM_HAS___TM_GMTOFF #undef tm_zone
09b6e22013-07-08Henrik Grubbström (Grubba) #undef tm_gmtoff
12327f2013-05-22Per Hedbor #endif
4907f62014-09-04Martin Nilsson 
12327f2013-05-22Per Hedbor /*! @endmodule */
7faf1e2005-01-08Henrik Grubbström (Grubba) /*! @decl array(array(int|string|type)) describe_program(program p)
2d8e642002-11-25Martin Nilsson  *! @belongs Debug
7d1b3b2001-12-21Henrik Grubbström (Grubba)  *! *! Debug function for showing the symbol table of a program.
7faf1e2005-01-08Henrik Grubbström (Grubba)  *! *! @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.
7d1b3b2001-12-21Henrik Grubbström (Grubba)  */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
7d1b3b2001-12-21Henrik Grubbström (Grubba) PIKEFUN array(array(int|string)) _describe_program(mixed x) efun; { struct program *p; struct array *res; int i;
d4ecd72003-01-05Martin Nilsson  if (!(p = program_from_svalue(Pike_sp - args))) SIMPLE_BAD_ARG_ERROR("_describe_program", 1, "program");
7d1b3b2001-12-21Henrik Grubbström (Grubba)  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);
cab69e2002-04-24Henrik Grubbström (Grubba)  struct inherit *inh = INHERIT_FROM_PTR(p, ref);
7d1b3b2001-12-21Henrik Grubbström (Grubba)  push_int(ref->id_flags); ref_push_string(id->name);
7faf1e2005-01-08Henrik Grubbström (Grubba)  ref_push_type_value(id->type);
cab69e2002-04-24Henrik Grubbström (Grubba)  push_int(id->identifier_flags);
c278f72003-08-03Martin Stjernholm  if (IDENTIFIER_IS_C_FUNCTION(id->identifier_flags)) {
cab69e2002-04-24Henrik Grubbström (Grubba)  push_int(-2); } else { push_int(id->func.offset); } push_int(ref->inherit_offset); push_int(inh->inherit_level);
7faf1e2005-01-08Henrik Grubbström (Grubba)  f_aggregate(7);
7d1b3b2001-12-21Henrik Grubbström (Grubba)  } f_aggregate(p->num_identifier_references);
cdf18a2003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
cbaa3a2002-05-24Henrik Grubbström (Grubba)  res = Pike_sp[-1].u.array; Pike_sp--;
7d1b3b2001-12-21Henrik Grubbström (Grubba)  pop_n_elems(args); push_array(res); }
d9a93b2001-07-01Fredrik Hübinette (Hubbe) /*! @decl string basetype(mixed x) *! *! Same as sprintf("%t",x); *! *! @seealso *! @[sprintf()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
d9a93b2001-07-01Fredrik Hübinette (Hubbe) PIKEFUN string basetype(mixed x) efun; optflags OPT_TRY_OPTIMIZE; {
017b572011-10-28Henrik Grubbström (Grubba)  int t = TYPEOF(*x);
2a8be12004-12-21Henrik Grubbström (Grubba)  struct program *p;
017b572011-10-28Henrik Grubbström (Grubba)  if(t == T_OBJECT && (p = x->u.object->prog))
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  ptrdiff_t fun = FIND_LFUN(p->inherits[SUBTYPEOF(*x)].prog, LFUN__SPRINTF);
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  if(fun != -1) { push_int('t'); f_aggregate_mapping(0);
2a8be12004-12-21Henrik Grubbström (Grubba)  apply_low(x->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  fun + p->inherits[SUBTYPEOF(*x)].identifier_level, 2); if(TYPEOF(Pike_sp[-1]) == T_STRING)
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  { stack_swap(); pop_stack(); return;
9f516a2001-12-16Martin Stjernholm  } else if (UNSAFE_IS_ZERO(Pike_sp-1)) {
63a7302001-07-02Henrik Grubbström (Grubba)  pop_n_elems(2);
6a932b2014-08-18Martin Nilsson  ref_push_string(literal_object_string);
9db2bf2001-07-02Henrik Grubbström (Grubba)  return; } else { Pike_error("Non-string returned from _sprintf()\n");
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  } } } pop_stack(); switch(t) {
6a932b2014-08-18Martin Nilsson  case T_ARRAY: ref_push_string(literal_array_string); break; case T_FLOAT: ref_push_string(literal_float_string); break; case T_FUNCTION: ref_push_string(literal_function_string); break; case T_INT: ref_push_string(literal_int_string); break; case T_MAPPING: ref_push_string(literal_mapping_string); break; case T_MULTISET: ref_push_string(literal_multiset_string); break; case T_OBJECT: ref_push_string(literal_object_string); break; case T_PROGRAM: ref_push_string(literal_program_string); break; case T_STRING: ref_push_string(literal_string_string); break; case T_TYPE: ref_push_string(literal_type_string); break;
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  case T_ZERO: push_constant_text("zero"); break; case T_VOID: push_constant_text("void"); break;
a903032003-02-16Martin Stjernholm  /* The following are internal and shouldn't be applicable in normal use. */
7cf0162014-05-22Per Hedbor  case T_SVALUE_PTR: push_text("svalue_ptr"); break; case T_OBJ_INDEX: push_text("obj_index"); break; case T_MAPPING_DATA: push_text("mapping_data"); break; case T_PIKE_FRAME: push_text("pike_frame"); break; case T_MULTISET_DATA: push_text("multiset_data"); break; default: push_text("unknown"); break;
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  } } /*! @decl string int2char(int x)
ba24802002-04-07Martin Nilsson  *! @appears String.int2char
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  *! *! Same as sprintf("%c",x); *! *! @seealso *! @[sprintf()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
d9a93b2001-07-01Fredrik Hübinette (Hubbe) PIKEFUN string int2char(int|object x) efun; optflags OPT_TRY_OPTIMIZE;
6416012014-08-31Henrik Grubbström (Grubba)  rawtype tFunc(tSetvar(0, tOr(tInt,tObj)), tNStr(tVar(0)));
d9a93b2001-07-01Fredrik Hübinette (Hubbe) { int c;
2a8be12004-12-21Henrik Grubbström (Grubba)  struct program *p;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*x) == T_OBJECT && (p = x->u.object->prog))
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  ptrdiff_t fun = FIND_LFUN(p->inherits[SUBTYPEOF(*x)].prog, LFUN__SPRINTF);
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  if(fun != -1) { push_int('c'); f_aggregate_mapping(0);
2a8be12004-12-21Henrik Grubbström (Grubba)  apply_low(x->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  fun + p->inherits[SUBTYPEOF(*x)].identifier_level, 2); if(TYPEOF(Pike_sp[-1]) == T_STRING)
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  { stack_swap(); pop_stack(); return; }
8f5b5b2001-07-02Henrik Grubbström (Grubba)  Pike_error("Non-string returned from _sprintf()\n");
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  } }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*x) != T_INT)
d4ecd72003-01-05Martin Nilsson  SIMPLE_BAD_ARG_ERROR("int2char", 1, "int");
d9a93b2001-07-01Fredrik Hübinette (Hubbe)  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); } }
7b45292001-08-15Fredrik Hübinette (Hubbe) /*! @decl string int2hex(int x)
ba24802002-04-07Martin Nilsson  *! @appears String.int2hex
7b45292001-08-15Fredrik Hübinette (Hubbe)  *!
e97b362004-04-25Martin Nilsson  *! Same as @expr{sprintf("%x",x);@}, i.e. returns the integer @[x] in *! hexadecimal base using lower cased symbols.
7b45292001-08-15Fredrik Hübinette (Hubbe)  *! *! @seealso *! @[sprintf()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
7b45292001-08-15Fredrik Hübinette (Hubbe) PIKEFUN string int2hex(int|object x) efun; optflags OPT_TRY_OPTIMIZE; { INT_TYPE c;
a973872003-01-26Mirar (Pontus Hagland)  unsigned INT_TYPE n;
7b45292001-08-15Fredrik Hübinette (Hubbe)  int len; struct pike_string *s;
2a8be12004-12-21Henrik Grubbström (Grubba)  struct program *p;
7b45292001-08-15Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*x) == T_OBJECT && (p = x->u.object->prog))
7b45292001-08-15Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  ptrdiff_t fun = FIND_LFUN(p->inherits[SUBTYPEOF(*x)].prog, LFUN__SPRINTF);
7b45292001-08-15Fredrik Hübinette (Hubbe)  if(fun != -1) { push_int('x'); f_aggregate_mapping(0);
2a8be12004-12-21Henrik Grubbström (Grubba)  apply_low(x->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  fun + p->inherits[SUBTYPEOF(*x)].identifier_level, 2); if(TYPEOF(Pike_sp[-1]) == T_STRING)
7b45292001-08-15Fredrik Hübinette (Hubbe)  { stack_swap(); pop_stack(); return; } Pike_error("Non-string returned from _sprintf()\n"); } }
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*x) != T_INT)
d4ecd72003-01-05Martin Nilsson  SIMPLE_BAD_ARG_ERROR("int2hex", 1, "int");
7b45292001-08-15Fredrik Hübinette (Hubbe)  c=x->u.integer; len=1; if(c<0) { len++;
9c3a7c2003-01-26Mirar (Pontus Hagland)  n=(-c)&((unsigned INT_TYPE)(-1));
7b45292001-08-15Fredrik Hübinette (Hubbe)  }else{ n=c; }
301e982002-01-18Martin Nilsson  while(n>65535) { n>>=16; len+=4; } while(n>15) { n>>=4; len++; }
7b45292001-08-15Fredrik Hübinette (Hubbe)  s=begin_shared_string(len); if(!c) { s->str[0]='0'; }else{ if(c<0) { s->str[0]='-';
9c3a7c2003-01-26Mirar (Pontus Hagland)  n=(-c)&((unsigned INT_TYPE)(-1));
7b45292001-08-15Fredrik Hübinette (Hubbe)  }else{ n=c; }
301e982002-01-18Martin Nilsson  while(len && n)
7b45292001-08-15Fredrik Hübinette (Hubbe)  { s->str[--len]="0123456789abcdef"[n&0xf]; n>>=4; } } RETURN end_shared_string(s); }
8d251e2003-09-05Martin Nilsson 
b2d3ca2003-08-26Martin Nilsson /*! @decl string string2hex(string data) *! @appears String.string2hex *! *! Convert a string of binary data to a hexadecimal string. *! *! @seealso *! @[hex2string()] */
b2f5ff2011-11-04Per Hedbor  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, };
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
00a65b2013-12-11Per Hedbor  PIKEFUN string(0..255) string2hex(string s)
b2d3ca2003-08-26Martin Nilsson  optflags OPT_TRY_OPTIMIZE; { struct pike_string *hex;
b2f5ff2011-11-04Per Hedbor  unsigned char *p,*st = (unsigned char *)s->str; int i, l;
b2d3ca2003-08-26Martin Nilsson  if (s->size_shift) Pike_error("Bad argument 1 to string2hex(), expected 8-bit string.\n"); hex = begin_shared_string(2 * s->len);
b2f5ff2011-11-04Per Hedbor  p = (unsigned char *)hex->str; l = s->len;
8d251e2003-09-05Martin Nilsson 
b2f5ff2011-11-04Per Hedbor  for (i=0; i<l; i++) { *p++ = hexchar[*st>>4]; *p++ = hexchar[*st&15]; st++;
8d251e2003-09-05Martin Nilsson  }
b2d3ca2003-08-26Martin Nilsson  RETURN end_shared_string(hex); } /*! @decl string hex2string(string hex) *! @appears String.hex2string *! *! Convert a string of hexadecimal digits to binary data. *! *! @seealso *! @[string2hex()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
00a65b2013-12-11Per Hedbor PIKEFUN string(0..255) hex2string(string hex)
b2d3ca2003-08-26Martin Nilsson  optflags OPT_TRY_OPTIMIZE; { struct pike_string *s;
b2f5ff2011-11-04Per Hedbor  int tmp, i; unsigned char *p, *q = (unsigned char *)hex->str;
8d251e2003-09-05Martin Nilsson  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");
b2d3ca2003-08-26Martin Nilsson 
8d251e2003-09-05Martin Nilsson  s = begin_shared_string(l);
b2f5ff2011-11-04Per Hedbor  p = (unsigned char *)s->str;
8d251e2003-09-05Martin Nilsson  for (i=0; i<l; i++)
b2d3ca2003-08-26Martin Nilsson  {
b2f5ff2011-11-04Per Hedbor  tmp = hexdecode[*q++]; *p++ = (tmp<<4) | hexdecode[*q++];
b2d3ca2003-08-26Martin Nilsson  } RETURN end_shared_string(s); }
5a3fc02014-04-08Martin Nilsson /*! @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)
de22f72014-08-25Martin Nilsson  errname range;
5a3fc02014-04-08Martin Nilsson  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); }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl array column(array data, mixed index) *! *! Extract a column from a two-dimensional array. *! *! This function is exactly equivalent to:
f79bd82003-04-01Martin Nilsson  *! @code *! map(@[data], lambda(mixed x,mixed y) { return x[y]; }, @[index]) *! @endcode
0498332001-02-10Henrik Grubbström (Grubba)  *! *! 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()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
b0f8352001-01-07Henrik Grubbström (Grubba) PIKEFUN array column(array data, mixed index)
3a5b1d2000-05-24Fredrik Hübinette (Hubbe)  efun; optflags OPT_TRY_OPTIMIZE; {
bcd8012003-04-28Martin Stjernholm  RETURN array_column (data, index, 1);
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl multiset mkmultiset(array a) *! *! This function creates a multiset from an array. *! *! @seealso *! @[aggregate_multiset()] *! */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) PIKEFUN multiset(1) mkmultiset(array(1=mixed) a) efun;
8f998d2000-08-31Henrik Grubbström (Grubba)  optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND;
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) { RETURN mkmultiset(a); }
50d97a2003-02-01Martin Stjernholm /*! @decl int trace(int level, void|string facility, void|int all_threads)
0498332001-02-10Henrik Grubbström (Grubba)  *!
50d97a2003-02-01Martin Stjernholm  *! 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.
0498332001-02-10Henrik Grubbström (Grubba)  *!
50d97a2003-02-01Martin Stjernholm  *! 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.
0498332001-02-10Henrik Grubbström (Grubba)  *! *! See the @tt{-t@} command-line option for more information.
6198092003-01-08Martin Stjernholm  *!
50d97a2003-02-01Martin Stjernholm  *! @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
2fe0542003-02-01Martin Stjernholm  *! @value 1
50d97a2003-02-01Martin Stjernholm  *! Trace calls to Pike functions and garbage collector runs.
2fe0542003-02-01Martin Stjernholm  *! @value 2
50d97a2003-02-01Martin Stjernholm  *! Trace calls to builtin functions.
2fe0542003-02-01Martin Stjernholm  *! @value 3
50d97a2003-02-01Martin Stjernholm  *! Trace every interpreted opcode.
2fe0542003-02-01Martin Stjernholm  *! @value 4
50d97a2003-02-01Martin Stjernholm  *! Also trace the opcode arguments. *! @endint *! *! @param facility *! Valid facilities are: *! *! @string
2fe0542003-02-01Martin Stjernholm  *! @value "gc"
e7a6482009-11-20Martin Stjernholm  *! 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
50d97a2003-02-01Martin Stjernholm  *! @endstring
6198092003-01-08Martin Stjernholm  *! *! @param all_threads
50d97a2003-02-01Martin Stjernholm  *! 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.
6198092003-01-08Martin Stjernholm  *! *! @returns
50d97a2003-02-01Martin Stjernholm  *! The old trace level in the current thread is returned.
0498332001-02-10Henrik Grubbström (Grubba)  */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
c834442008-05-29Martin Stjernholm PIKEFUN int trace(int level, void|string facility, void|zero|int all_threads)
098c802000-05-24Fredrik Hübinette (Hubbe)  efun; optflags OPT_SIDE_EFFECT; {
50d97a2003-02-01Martin Stjernholm  INT32 old_level; if (facility) { struct pike_string *gc_str;
de56ec2003-02-08Martin Stjernholm  MAKE_CONST_STRING(gc_str, "gc");
fe21442004-09-02Henrik Grubbström (Grubba)  if (facility == gc_str) {
50d97a2003-02-01Martin Stjernholm  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."); }
6198092003-01-08Martin Stjernholm  }
50d97a2003-02-01Martin Stjernholm  else { old_level = Pike_interpreter.trace_level; #ifdef PIKE_THREADS
c834442008-05-29Martin Stjernholm  if (!all_threads)
50d97a2003-02-01Martin Stjernholm  Pike_interpreter.trace_level = level; else { struct thread_state *s; FOR_EACH_THREAD(s, s->state.trace_level = level); }
6198092003-01-08Martin Stjernholm #else
50d97a2003-02-01Martin Stjernholm  Pike_interpreter.trace_level = level;
6198092003-01-08Martin Stjernholm #endif
50d97a2003-02-01Martin Stjernholm  } RETURN old_level;
098c802000-05-24Fredrik Hübinette (Hubbe) }
51adb82003-01-12Martin Stjernholm /*! @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"
0d9f932003-01-14Martin Stjernholm  *! 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.
51adb82003-01-12Martin Stjernholm  *! @member float "garbage_ratio_low"
85f8c72010-06-22Martin Stjernholm  *! As long as the gc time is less than time_ratio below, aim to run
51adb82003-01-12Martin Stjernholm  *! the gc approximately every time the ratio between the garbage *! and the total amount of allocated things is this. *! @member float "time_ratio"
85f8c72010-06-22Martin Stjernholm  *! When more than this fraction of the time is spent in the gc, aim *! for garbage_ratio_high instead of garbage_ratio_low.
51adb82003-01-12Martin Stjernholm  *! @member float "garbage_ratio_high" *! Upper limit for the garbage ratio - run the gc as often as it *! takes to keep it below this.
85f8c72010-06-22Martin Stjernholm  *! @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.
51adb82003-01-12Martin Stjernholm  *! @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.
b6a9792013-06-26Henrik Grubbström (Grubba)  *! @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.
e0fa982014-01-17Henrik Grubbström (Grubba)  *! @member function(object,int,int:void) "destruct_cb"
b6a9792013-06-26Henrik Grubbström (Grubba)  *! This function is called once for each object that is part of *! a cycle just before the gc will destruct it.
e0fa982014-01-17Henrik Grubbström (Grubba)  *! 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
b6a9792013-06-26Henrik Grubbström (Grubba)  *! @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().
51adb82003-01-12Martin Stjernholm  *! @endmapping *! *! @seealso *! @[gc], @[Debug.gc_status] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
51adb82003-01-12Martin Stjernholm PIKEFUN mapping(string:mixed) gc_parameters (void|mapping(string:mixed) params) optflags OPT_SIDE_EFFECT; { struct pike_string *str; struct svalue *set; struct svalue get; if (!params) {
85f8c72010-06-22Martin Stjernholm  push_mapping (allocate_mapping (6));
fe21442004-09-02Henrik Grubbström (Grubba)  params = Pike_sp[-1].u.mapping;
51adb82003-01-12Martin Stjernholm  } #define HANDLE_PARAM(NAME, CHECK_AND_SET, GET) do { \
de56ec2003-02-08Martin Stjernholm  MAKE_CONST_STRING (str, NAME); \
fe21442004-09-02Henrik Grubbström (Grubba)  if ((set = low_mapping_string_lookup (params, str))) { \
51adb82003-01-12Martin Stjernholm  CHECK_AND_SET; \ } \ else { \ GET; \
fe21442004-09-02Henrik Grubbström (Grubba)  mapping_string_insert (params, str, &get); \
51adb82003-01-12Martin Stjernholm  } \ } while (0) #define HANDLE_FLOAT_FACTOR(NAME, VAR) \ HANDLE_PARAM (NAME, { \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*set) != T_FLOAT || \
51adb82003-01-12Martin Stjernholm  set->u.float_number < 0.0 || set->u.float_number > 1.0) \
de22f72014-08-25Martin Nilsson  SIMPLE_BAD_ARG_ERROR ("gc_parameters", 1, \
0d9f932003-01-14Martin Stjernholm  "float between 0.0 and 1.0 for " NAME); \
1abbfb2006-07-05Martin Stjernholm  VAR = DO_NOT_WARN ((double) set->u.float_number); \
51adb82003-01-12Martin Stjernholm  }, { \
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(get, T_FLOAT, 0, float_number, \ DO_NOT_WARN ((FLOAT_TYPE) VAR)); \
51adb82003-01-12Martin Stjernholm  }); HANDLE_PARAM ("enabled", {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*set) != T_INT || set->u.integer < -1 || set->u.integer > 1)
de22f72014-08-25Martin Nilsson  SIMPLE_BAD_ARG_ERROR ("gc_parameters", 1,
0d9f932003-01-14Martin Stjernholm  "integer in the range -1..1 for 'enabled'"); if (gc_enabled != set->u.integer) {
b7a5c32012-07-06Martin Stjernholm  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;
51adb82003-01-12Martin Stjernholm  }
b7a5c32012-07-06Martin Stjernholm  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;
51adb82003-01-12Martin Stjernholm  } }, {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(get, T_INT, NUMBER_NUMBER, integer, gc_enabled);
51adb82003-01-12Martin Stjernholm  }); 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);
85f8c72010-06-22Martin Stjernholm  HANDLE_FLOAT_FACTOR ("min_gc_time_ratio", gc_min_time_ratio);
51adb82003-01-12Martin Stjernholm  HANDLE_FLOAT_FACTOR ("average_slowness", gc_average_slowness);
b6a9792013-06-26Henrik Grubbström (Grubba)  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); });
51adb82003-01-12Martin Stjernholm #undef HANDLE_PARAM #undef HANDLE_FLOAT_FACTOR
fe21442004-09-02Henrik Grubbström (Grubba)  REF_RETURN params;
51adb82003-01-12Martin Stjernholm }
d6fd962001-02-10Henrik Grubbström (Grubba) /*! @decl string ctime(int timestamp) *!
0498332001-02-10Henrik Grubbström (Grubba)  *! Convert the output from a previous call to @[time()] into a readable *! string containing the current year, month, day and time. *!
f917a32002-10-03Martin Stjernholm  *! 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].
21f3f62002-10-03Martin Stjernholm  *!
0498332001-02-10Henrik Grubbström (Grubba)  *! @seealso *! @[time()], @[localtime()], @[mktime()], @[gmtime()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
14f6892008-04-22Martin Stjernholm PIKEFUN string ctime(longest timestamp)
098c802000-05-24Fredrik Hübinette (Hubbe)  efun; optflags OPT_TRY_OPTIMIZE; {
14f6892008-04-22Martin Stjernholm  time_t i; char *s; #if SIZEOF_TIME_T < SIZEOF_LONGEST
ad8ee62008-04-23Martin Nilsson  if (timestamp > MAX_TIME_T || timestamp < MIN_TIME_T)
7712092008-04-23Martin Stjernholm  SIMPLE_ARG_ERROR ("ctime", 1, "Timestamp outside valid range.");
14f6892008-04-22Martin Stjernholm #endif i = (time_t) timestamp; s = ctime (&i);
f917a32002-10-03Martin Stjernholm  if (!s) Pike_error ("ctime() on this system cannot handle " "the timestamp %ld.\n", (long) i);
21f3f62002-10-03Martin Stjernholm  RETURN make_shared_string(s);
098c802000-05-24Fredrik Hübinette (Hubbe) }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl mapping mkmapping(array ind, array val) *! *! Make a mapping from two arrays. *! *! Makes a mapping @[ind[x]]:@[val[x]], @tt{0 <= x < sizeof(ind)@}. *! *! @[ind] and @[val] must have the same size. *! *! This is the inverse operation of @[indices()] and @[values()]. *! *! @seealso *! @[indices()], @[values()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
b0f8352001-01-07Henrik Grubbström (Grubba) PIKEFUN mapping(1:2) mkmapping(array(1=mixed) ind, array(2=mixed) val)
098c802000-05-24Fredrik Hübinette (Hubbe)  efun;
8f998d2000-08-31Henrik Grubbström (Grubba)  optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND;
098c802000-05-24Fredrik Hübinette (Hubbe) {
b0f8352001-01-07Henrik Grubbström (Grubba)  if(ind->size != val->size)
cbaa3a2002-05-24Henrik Grubbström (Grubba)  bad_arg_error("mkmapping", Pike_sp-args, args, 2, "array", Pike_sp+1-args,
098c802000-05-24Fredrik Hübinette (Hubbe)  "mkmapping called on arrays of different sizes (%d != %d)\n",
b0f8352001-01-07Henrik Grubbström (Grubba)  ind->size, val->size);
098c802000-05-24Fredrik Hübinette (Hubbe) 
b0f8352001-01-07Henrik Grubbström (Grubba)  RETURN mkmapping(ind, val);
098c802000-05-24Fredrik Hübinette (Hubbe) }
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) 
3ee7482014-07-27Henrik Grubbström (Grubba) /*! @decl string secure(string str)
aff1972008-06-29Martin Nilsson  *! @belongs String *! *! Marks the string as secure, which will clear the memory area *! before freeing the string.
4b99202014-07-29Henrik Grubbström (Grubba)  *! *! @seealso *! @[Object.secure()]
aff1972008-06-29Martin Nilsson  */
56e48a2008-06-30Henrik Grubbström (Grubba) PIKEFUN string string_secure(string str) optflags OPT_SIDE_EFFECT; rawtype tFunc(tSetvar(0, tStr), tVar(0));
aff1972008-06-29Martin Nilsson { str->flags |= STRING_CLEAR_ON_EXIT;
8d9a1b2008-06-30Henrik Grubbström (Grubba)  REF_RETURN str;
aff1972008-06-29Martin Nilsson }
3ee7482014-07-27Henrik Grubbström (Grubba) /*! @decl object secure(object str) *! @belongs Object *! *! Marks the object as secure, which will clear the memory area *! before freeing the object.
4b99202014-07-29Henrik Grubbström (Grubba)  *! *! @seealso *! @[String.secure()]
3ee7482014-07-27Henrik Grubbström (Grubba)  */ PIKEFUN object object_secure(object obj) optflags OPT_SIDE_EFFECT; rawtype tFunc(tSetvar(0, tObj), tVar(0)); { obj->flags |= OBJECT_CLEAR_ON_EXIT; REF_RETURN obj; }
31acb72001-07-26Martin Nilsson /*! @decl int count(string haystack, string needle) *! @belongs String
0498332001-02-10Henrik Grubbström (Grubba)  *!
c5e2a42004-04-30Martin Nilsson  *! 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.
0498332001-02-10Henrik Grubbström (Grubba)  *! *! @seealso *! @[search()], @[`/()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
6613052000-08-10Henrik Grubbström (Grubba) PIKEFUN int string_count(string haystack, string needle)
de22f72014-08-25Martin Nilsson  errname count;
991fdf2000-05-25Fredrik Hübinette (Hubbe)  optflags OPT_TRY_OPTIMIZE; {
89fc4c2000-08-10Henrik Grubbström (Grubba)  ptrdiff_t c = 0; ptrdiff_t i, j;
991fdf2000-05-25Fredrik Hübinette (Hubbe)  switch (needle->len) { case 0: switch (haystack->len) { case 0: c=1; break; /* "" appears one time in "" */ case 1: c=0; break; /* "" doesn't appear in "x" */ default: c=haystack->len-1; /* one time between each character */ } break; case 1: /* maybe optimize? */
c5e2a42004-04-30Martin Nilsson  /* It is already fairly optimized in pike_search_engine. */
991fdf2000-05-25Fredrik Hübinette (Hubbe)  default: for (i=0; i<haystack->len; i++) { j=string_search(haystack,needle,i); if (j==-1) break; i=j+needle->len-1; c++; } break; }
6613052000-08-10Henrik Grubbström (Grubba)  RETURN DO_NOT_WARN((INT_TYPE)c);
991fdf2000-05-25Fredrik Hübinette (Hubbe) }
31acb72001-07-26Martin Nilsson /*! @decl string trim_whites (string s) *! @belongs String
5117f12001-04-16Martin Stjernholm  *! *! Trim leading and trailing spaces and tabs from the string @[s]. */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
5117f12001-04-16Martin Stjernholm PIKEFUN string string_trim_whites (string s)
de22f72014-08-25Martin Nilsson  errname trim_whites;
5117f12001-04-16Martin Stjernholm  optflags OPT_TRY_OPTIMIZE; { ptrdiff_t start = 0, end = s->len; int chr; switch (s->size_shift) { #define DO_IT(TYPE) \ { \ for (; start < s->len; start++) { \ chr = ((TYPE *) s->str)[start]; \ if (chr != ' ' && chr != '\t') break; \ } \ while (--end > start) { \ chr = ((TYPE *) s->str)[end]; \ if (chr != ' ' && chr != '\t') break; \ } \ } case 0: DO_IT (p_wchar0); break; case 1: DO_IT (p_wchar1); break; case 2: DO_IT (p_wchar2); break; #undef DO_IT } RETURN string_slice (s, start, end + 1 - start); }
dfae9d2010-01-02Stephen R. van den Berg /*! @decl string normalize_space (string s, string|void whitespace) *! @belongs String *!
8152502010-01-02Stephen R. van den Berg  *! @param s *! Is returned after white space in it has been normalised.
dfae9d2010-01-02Stephen R. van den Berg  *! White space is normalised by stripping leading and trailing white space *! and replacing sequences of white space characters with a single space. *!
8152502010-01-02Stephen R. van den Berg  *! @param whitespace *! Defines what is considered to be white space eligible for normalisation.
fa5fcc2010-01-08Stephen R. van den Berg  *! 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.
9a979e2010-01-09Stephen R. van den Berg  *! The first character denotes the character for replacing whitespace *! sequences.
8152502010-01-02Stephen R. van den Berg  *! *! @note *! Trailing and leading whitespace around \r and \n characters *! is stripped as well (only useful if they're not in the @[whitespace] set).
9a979e2010-01-09Stephen R. van den Berg  *! *! @note *! This function is a lot faster with just one argument (i.e. the builtin *! whitespace set has an optimised code path).
dfae9d2010-01-02Stephen R. van den Berg  */ PMOD_EXPORT PIKEFUN string string_normalize_space (string s, string|void whitespace)
de22f72014-08-25Martin Nilsson  errname normalize_space;
dfae9d2010-01-02Stephen R. van den Berg  optflags OPT_TRY_OPTIMIZE;
fa5fcc2010-01-08Stephen R. van den Berg { size_t len = s->len, wlen; const void *src = s->str; unsigned shift = s->size_shift, replspace; const void *ws; void *wstemp = 0;
dfae9d2010-01-02Stephen R. van den Berg  struct string_builder sb; unsigned foundspace = 0;
f39c292010-01-11Stephen R. van den Berg  wlen = replspace = 0; /* useless, but suppresses silly compiler warning */
fa5fcc2010-01-08Stephen R. van den Berg  { 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;
22c7d82010-01-08Stephen R. van den Berg  if(wshift!=shift) { /* convert whitespace to shift of input */
fa5fcc2010-01-08Stephen R. van den Berg  PCHARP pcnws;
22c7d82010-01-08Stephen R. van den Berg  wstemp = xalloc(wlen<<shift); pcnws = MKPCHARP(wstemp, shift); if(wshift>shift) {
4ce3db2010-01-11Jonas Wallden  PCHARP pcows = MKPCHARP_STR(whitespace);
fa5fcc2010-01-08Stephen R. van den Berg  size_t clen = wlen, i; i = wlen = 0; do { unsigned chr = INDEX_PCHARP(pcows, i++);
f39c292010-01-11Stephen R. van den Berg  if (chr<=0xff || (chr<=0xffff && shift)) /* shift is 0 or 1 */
fa5fcc2010-01-08Stephen R. van den Berg  SET_INDEX_PCHARP(pcnws, wlen++, chr); } while(--clen); } else pike_string_cpy(pcnws, whitespace); ws = wstemp; } }
dfae9d2010-01-02Stephen R. van den Berg  else
fa5fcc2010-01-08Stephen R. van den Berg  ws = 0; init_string_builder_alloc (&sb, len, bshift); if(bshift == shift) sb.known_shift = bshift; }
6528232010-01-09Stephen R. van den Berg 
dfae9d2010-01-02Stephen R. van den Berg  switch (shift) {
fa5fcc2010-01-08Stephen R. van den Berg #define NORMALISE_TIGHT_LOOP(TYPE,CASE) \ { \ const TYPE *start = src, *end = start+len; \
d6206f2010-01-02Stephen R. van den Berg  if (!ws) { \
fa5fcc2010-01-08Stephen R. van den Berg  TYPE *dst = (void*)sb.s->str; \
d6206f2010-01-02Stephen R. van den Berg  for (; start < end; start++) { \
7950ba2010-01-02Stephen R. van den Berg  switch(*start) { \
6528232010-01-09Stephen R. van den Berg  CASE \
7950ba2010-01-02Stephen R. van den Berg  continue; \ } \ break; \
dfae9d2010-01-02Stephen R. van den Berg  } \
d6206f2010-01-02Stephen R. van den Berg  for (; start < end; start++) { \
fa5fcc2010-01-08Stephen R. van den Berg  if(*start<=' ' || *start>=0x85) /* optimise common case */ \ switch(*start) { \
6528232010-01-09Stephen R. van den Berg  CASE \
5f84e02010-01-09Stephen R. van den Berg  if (!foundspace) \ *dst++ = ' ', foundspace=1; \
7950ba2010-01-02Stephen R. van den Berg  continue; \
fa5fcc2010-01-08Stephen R. van den Berg  default:goto found##TYPE; \ } \ else \ found##TYPE: \ foundspace=0; \ *dst++ = *start; \
d6206f2010-01-02Stephen R. van den Berg  } \
fa5fcc2010-01-08Stephen R. van den Berg  sb.s->len = dst - (TYPE*)sb.s->str; \
d6206f2010-01-02Stephen R. van den Berg  } else { \
fa5fcc2010-01-08Stephen R. van den Berg  const TYPE*ps = (const TYPE*)ws+wlen; \
d6206f2010-01-02Stephen R. van den Berg  for (; start < end; start++) { \
fa5fcc2010-01-08Stephen R. van den Berg  size_t clen = wlen; \
d6206f2010-01-02Stephen R. van den Berg  do { \
f39c292010-01-11Stephen R. van den Berg  if (ps[0-clen] == *start) \
d6206f2010-01-02Stephen R. van den Berg  goto lead##TYPE; \
fa5fcc2010-01-08Stephen R. van den Berg  } while(--clen); \
d6206f2010-01-02Stephen R. van den Berg  break; \ lead##TYPE:; \ } \ for (; start < end; start++) { \
5f84e02010-01-09Stephen R. van den Berg  TYPE chr = *start; \
fa5fcc2010-01-08Stephen R. van den Berg  size_t clen = wlen; \
7950ba2010-01-02Stephen R. van den Berg  do \
f39c292010-01-11Stephen R. van den Berg  if (ps[0-clen] == chr) { \
5f84e02010-01-09Stephen R. van den Berg  if (!foundspace) \ string_builder_putchar(&sb, replspace), foundspace=1; \ goto skip##TYPE; \
7950ba2010-01-02Stephen R. van den Berg  } \
fa5fcc2010-01-08Stephen R. van den Berg  while(--clen); \
dfae9d2010-01-02Stephen R. van den Berg  if (foundspace && (chr=='\n' || chr=='\r')) { \
fa5fcc2010-01-08Stephen R. van den Berg  sb.s->len--; string_builder_putchar(&sb, chr); \ foundspace=0; \
dfae9d2010-01-02Stephen R. van den Berg  goto lead##TYPE; \ } \
5f84e02010-01-09Stephen R. van den Berg  string_builder_putchar(&sb, chr); foundspace=0; \
dfae9d2010-01-02Stephen R. van den Berg skip##TYPE:; \
d6206f2010-01-02Stephen R. van den Berg  } \
dfae9d2010-01-02Stephen R. van den Berg  } \ }
fa5fcc2010-01-08Stephen R. van den Berg  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
dfae9d2010-01-02Stephen R. van den Berg  }
fa5fcc2010-01-08Stephen R. van den Berg  if (wstemp) free(wstemp);
dfae9d2010-01-02Stephen R. van den Berg  if (foundspace)
fa5fcc2010-01-08Stephen R. van den Berg  sb.s->len--;
dfae9d2010-01-02Stephen R. van den Berg  RETURN finish_string_builder (&sb); }
31acb72001-07-26Martin Nilsson /*! @decl string trim_all_whites (string s) *! @belongs String
5117f12001-04-16Martin Stjernholm  *! *! Trim leading and trailing white spaces characters (space, tab,
4d32882010-03-02Martin Nilsson  *! newline, carriage return, form feed, vertical tab and all the *! white spaces defined in Unicode) from the string @[s].
5117f12001-04-16Martin Stjernholm  */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
5117f12001-04-16Martin Stjernholm PIKEFUN string string_trim_all_whites (string s)
de22f72014-08-25Martin Nilsson  errname trim_all_whites;
5117f12001-04-16Martin Stjernholm  optflags OPT_TRY_OPTIMIZE; { ptrdiff_t start = 0, end = s->len; int chr; switch (s->size_shift) {
4d32882010-03-02Martin Nilsson  #define DO_IT(TYPE,CASE) \
5117f12001-04-16Martin Stjernholm  { \
4d32882010-03-02Martin Nilsson  for (; start < end; start++) { \
5117f12001-04-16Martin Stjernholm  chr = ((TYPE *) s->str)[start]; \
4d32882010-03-02Martin Nilsson  switch(chr) { \ CASE \ continue; \ } \ break; \
5117f12001-04-16Martin Stjernholm  } \ while (--end > start) { \ chr = ((TYPE *) s->str)[end]; \
4d32882010-03-02Martin Nilsson  switch(chr) { \ CASE \ continue; \ } \ break; \
5117f12001-04-16Martin Stjernholm  } \ }
4d32882010-03-02Martin Nilsson  case 0: DO_IT (p_wchar0,SPACECASE8); break; case 1: DO_IT (p_wchar1,SPACECASE16); break; case 2: DO_IT (p_wchar2,SPACECASE16); break;
5117f12001-04-16Martin Stjernholm #undef DO_IT } RETURN string_slice (s, start, end + 1 - start); }
126fa42013-04-03Henrik Grubbström (Grubba) /*! @decl string status(int verbose)
af80262013-02-07Henrik Grubbström (Grubba)  *! @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)
de22f72014-08-25Martin Nilsson  errname status;
af80262013-02-07Henrik Grubbström (Grubba) { RETURN add_string_status(verbose); }
31acb72001-07-26Martin Nilsson /*! @decl int implements(program prog, program api) *! @belongs Program
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Returns 1 if @[prog] implements @[api]. */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
b0f8352001-01-07Henrik Grubbström (Grubba) PIKEFUN int program_implements(program prog, program api)
de22f72014-08-25Martin Nilsson  errname implements;
991fdf2000-05-25Fredrik Hübinette (Hubbe)  optflags OPT_TRY_OPTIMIZE; {
b0f8352001-01-07Henrik Grubbström (Grubba)  RETURN implements(prog, api);
991fdf2000-05-25Fredrik Hübinette (Hubbe) }
a9d8c32012-10-28Tobias S. Josefowitz /*! @decl int inherits(program|object child, program parent)
31acb72001-07-26Martin Nilsson  *! @belongs Program
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Returns 1 if @[child] has inherited @[parent]. */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
a9d8c32012-10-28Tobias S. Josefowitz PIKEFUN int program_inherits(program|object child, program parent)
de22f72014-08-25Martin Nilsson  errname inherits;
991fdf2000-05-25Fredrik Hübinette (Hubbe)  optflags OPT_TRY_OPTIMIZE; {
c1d4842012-10-28Tobias S. Josefowitz  struct program *p = program_from_svalue(child);
a9d8c32012-10-28Tobias S. Josefowitz 
c1d4842012-10-28Tobias S. Josefowitz  if (!p)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR("inherits", 1, "program|object");
c1d4842012-10-28Tobias S. Josefowitz  RETURN low_get_storage(p, parent) != -1;
991fdf2000-05-25Fredrik Hübinette (Hubbe) }
31acb72001-07-26Martin Nilsson /*! @decl string defined(program p) *! @belongs Program
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Returns a string with filename and linenumber describing where *! the program @[p] was defined. *!
cbe8c92003-04-07Martin Nilsson  *! The returned string is of the format @expr{"filename:linenumber"@}.
0498332001-02-10Henrik Grubbström (Grubba)  *!
cbe8c92003-04-07Martin Nilsson  *! If it cannot be determined where the program was defined, @expr{0@} *! (zero) will be returned.
0498332001-02-10Henrik Grubbström (Grubba)  */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
b8c5b22000-05-25Fredrik Hübinette (Hubbe) PIKEFUN string program_defined(program p)
de22f72014-08-25Martin Nilsson  errname defined;
b8c5b22000-05-25Fredrik Hübinette (Hubbe)  optflags OPT_TRY_OPTIMIZE; {
ef24a82012-01-12Henrik Grubbström (Grubba)  INT_TYPE line;
9de5ff2002-12-01Martin Stjernholm  struct pike_string *tmp = low_get_program_line(p, &line);
b8c5b22000-05-25Fredrik Hübinette (Hubbe) 
9de5ff2002-12-01Martin Stjernholm  pop_n_elems(args);
50edc82001-07-13Henrik Grubbström (Grubba) 
9de5ff2002-12-01Martin Stjernholm  if (tmp) {
50edc82001-07-13Henrik Grubbström (Grubba)  push_string(tmp); if(line >= 1) {
7cf0162014-05-22Per Hedbor  push_text(":");
50edc82001-07-13Henrik Grubbström (Grubba)  push_int(line); f_add(3);
b8c5b22000-05-25Fredrik Hübinette (Hubbe)  } }
9de5ff2002-12-01Martin Stjernholm  else push_int(0);
b8c5b22000-05-25Fredrik Hübinette (Hubbe) }
31acb72001-07-26Martin Nilsson /*! @decl int(8..8)|int(16..16)|int(32..32) width(string s) *! @belongs String
0498332001-02-10Henrik Grubbström (Grubba)  *! *! Returns the width of a string. *!
4448f42013-04-04Henrik Grubbström (Grubba)  *! @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.
0498332001-02-10Henrik Grubbström (Grubba)  */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
d6fd962001-02-10Henrik Grubbström (Grubba) PIKEFUN int(8 .. 8)|int(16 .. 16)|int(32 .. 32) string_width(string s)
de22f72014-08-25Martin Nilsson  errname width;
991fdf2000-05-25Fredrik Hübinette (Hubbe)  optflags OPT_TRY_OPTIMIZE; { RETURN 8 * (1 << s->size_shift); }
0498332001-02-10Henrik Grubbström (Grubba) /*! @decl mixed m_delete(object|mapping map, mixed index) *! *! If @[map] is an object that implements @[lfun::_m_delete()],
dd5cba2003-02-10Marek Habersack  *! that function will be called with @[index] as its single argument.
0498332001-02-10Henrik Grubbström (Grubba)  *!
dd5cba2003-02-10Marek Habersack  *! Otherwise if @[map] is a mapping the entry with index @[index]
0498332001-02-10Henrik Grubbström (Grubba)  *! will be removed from @[map] destructively. *! *! If the mapping does not have an entry with index @[index], nothing is done. *! *! @returns
52ced62003-02-11Henrik Grubbström (Grubba)  *! The value that was removed will be returned.
0498332001-02-10Henrik Grubbström (Grubba)  *! *! @note *! Note that @[m_delete()] changes @[map] destructively. *! *! @seealso *! @[mappingp()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
a3453e2001-02-05Per Hedbor PIKEFUN mixed m_delete(object|mapping map, mixed index)
7f80d42000-06-19Fredrik Hübinette (Hubbe)  efun; optflags OPT_SIDE_EFFECT;
d8a04b2005-11-14Martin Nilsson  rawtype tOr(tFunc(tMap(tSetvar(0,tMix),tSetvar(1,tMix)) tVar(0),tVar(1)),tFunc(tObj tMix,tMix))
7f80d42000-06-19Fredrik Hübinette (Hubbe) {
2a8be12004-12-21Henrik Grubbström (Grubba)  struct program *p;
017b572011-10-28Henrik Grubbström (Grubba)  if( TYPEOF(*map) == T_MAPPING )
a3453e2001-02-05Per Hedbor  { struct svalue s; map_delete_no_free(map->u.mapping, index, &s); pop_n_elems(args);
cbaa3a2002-05-24Henrik Grubbström (Grubba)  *Pike_sp=s; Pike_sp++;
cdf18a2003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
a3453e2001-02-05Per Hedbor  }
017b572011-10-28Henrik Grubbström (Grubba)  else if (TYPEOF(*map) == T_OBJECT && (p = map->u.object->prog))
a3453e2001-02-05Per Hedbor  {
017b572011-10-28Henrik Grubbström (Grubba)  int id = FIND_LFUN(p->inherits[SUBTYPEOF(*map)].prog, LFUN__M_DELETE);
ea56012001-02-09Per Hedbor  if( id == -1 )
e786012003-02-11Marek Habersack  SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object containing the _m_delete method");
ea56012001-02-09Per Hedbor 
2a8be12004-12-21Henrik Grubbström (Grubba)  apply_low(map->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  id + p->inherits[SUBTYPEOF(*map)].identifier_level, 1);
a3453e2001-02-05Per Hedbor  stack_swap(); pop_stack();
79f6982001-02-05Henrik Grubbström (Grubba)  } else { SIMPLE_BAD_ARG_ERROR("m_delete", 1, "object|mapping");
a3453e2001-02-05Per Hedbor  }
7f80d42000-06-19Fredrik Hübinette (Hubbe) }
9da7f42001-06-05Martin Stjernholm /*! @decl int get_weak_flag(array|mapping|multiset m)
0498332001-02-10Henrik Grubbström (Grubba)  *!
9da7f42001-06-05Martin Stjernholm  *! Returns the weak flag settings for @[m]. It's a combination of *! @[Pike.WEAK_INDICES] and @[Pike.WEAK_VALUES].
0498332001-02-10Henrik Grubbström (Grubba)  */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN int get_weak_flag(array m)
ee9fa92000-07-06Martin Stjernholm  efun;
8f998d2000-08-31Henrik Grubbström (Grubba)  optflags OPT_EXTERNAL_DEPEND;
ee9fa92000-07-06Martin Stjernholm {
e1b4192001-06-06Fredrik Hübinette (Hubbe)  RETURN (m->flags & ARRAY_WEAK_FLAG) ? PIKE_WEAK_VALUES : 0; }
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN int get_weak_flag(mapping m) { RETURN mapping_get_flags(m) & MAPPING_WEAK; }
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN int get_weak_flag(multiset m) {
5b15bb2001-12-10Martin Stjernholm  RETURN multiset_get_flags(m) & MULTISET_WEAK;
ee9fa92000-07-06Martin Stjernholm }
18c2252003-04-10Martin Nilsson /*! @decl program __empty_program(int|void line, string|void file) */
c834442008-05-29Martin Stjernholm PIKEFUN program __empty_program(int|zero|void line, string|void file)
aa68b12001-03-19Fredrik Hübinette (Hubbe)  efun; optflags OPT_EXTERNAL_DEPEND; {
c834442008-05-29Martin Stjernholm  struct program *prog = low_allocate_program(); if (file) ext_store_program_line (prog, line, file); RETURN prog;
aa68b12001-03-19Fredrik Hübinette (Hubbe) }
99f32f2009-02-21Henrik Grubbström (Grubba) /* 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); }
b82bbf2013-07-13Chris Angelico /*! @decl string function_name(function|program f)
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *!
b82bbf2013-07-13Chris Angelico  *! Return the name of the function or program @[f].
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *!
cbe8c92003-04-07Martin Nilsson  *! If @[f] is a global function defined in the runtime @expr{0@} *! (zero) will be returned.
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *! *! @seealso *! @[function_object()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
1c1c5e2001-04-08Fredrik Hübinette (Hubbe) PIKEFUN string function_name(program|function func) efun; optflags OPT_TRY_OPTIMIZE; {
42d5b32012-01-09Henrik Grubbström (Grubba)  int f = -1; struct program *p = NULL;
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*func))
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  { default:
d4ecd72003-01-05Martin Nilsson  SIMPLE_BAD_ARG_ERROR("function_name", 1, "function|program");
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  return; /* NOTREACHED */ case PIKE_T_PROGRAM: {
42d5b32012-01-09Henrik Grubbström (Grubba)  p = func->u.program;
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  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) &&
89378b2010-11-23Henrik Grubbström (Grubba)  (id->func.const_info.offset >= 0) && is_eq( & PROG_FROM_INT(p, e)->constants[id->func.const_info.offset].sval,
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  func)) REF_RETURN id->name; }
52ced62003-02-11Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (d_flag>5) { fprintf(stderr,
2523ce2003-04-28Martin Stjernholm  "Failed to find symbol for program %p\n"
52ced62003-02-11Henrik Grubbström (Grubba)  "Parent program info:\n", func->u.program); dump_program_tables(func->u.program->parent, 0); } #endif
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  } break; } case PIKE_T_FUNCTION:
42d5b32012-01-09Henrik Grubbström (Grubba)  if((f = SUBTYPEOF(*func)) == FUNCTION_BUILTIN) break; if(!(p = func->u.object->prog))
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  bad_arg_error("function_name", Pike_sp-args, args, 1, "function", Pike_sp-args, "Destructed object.\n");
42d5b32012-01-09Henrik Grubbström (Grubba)  if(p == pike_trampoline_program)
5a6d7d2001-04-10Fredrik Hübinette (Hubbe)  { struct pike_trampoline *t; t=((struct pike_trampoline *)func->u.object->storage);
c1f4762008-11-02Henrik Grubbström (Grubba) 
42d5b32012-01-09Henrik Grubbström (Grubba)  if(t->frame->current_object->prog) { p = t->frame->current_object->prog; f = t->func; }
5a6d7d2001-04-10Fredrik Hübinette (Hubbe)  }
c1f4762008-11-02Henrik Grubbström (Grubba) 
42d5b32012-01-09Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if(f >= p->num_identifier_references) Pike_fatal("Function without reference.\n"); #endif RETURN delambda(ID_FROM_INT(p, f)->name);
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  } pop_n_elems(args); push_int(0); }
6410612003-01-08Henrik Grubbström (Grubba) /*! @decl object function_object(function f)
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *!
6410612003-01-08Henrik Grubbström (Grubba)  *! Return the object the function @[f] is in.
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *!
cbe8c92003-04-07Martin Nilsson  *! If @[f] is a global function defined in the runtime @expr{0@} *! (zero) will be returned.
6410612003-01-08Henrik Grubbström (Grubba)  *! *! 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.
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  *! *! @seealso
6410612003-01-08Henrik Grubbström (Grubba)  *! @[function_name()], @[function_program()]
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
51adb82003-01-12Martin Stjernholm PIKEFUN object function_object(function|program func)
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  efun; optflags OPT_TRY_OPTIMIZE;
6410612003-01-08Henrik Grubbström (Grubba)  type function(function:object);
1c1c5e2001-04-08Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*func))
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  { case PIKE_T_PROGRAM:
6410612003-01-08Henrik Grubbström (Grubba)  break;
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  case PIKE_T_FUNCTION:
017b572011-10-28Henrik Grubbström (Grubba)  if(SUBTYPEOF(*func) == FUNCTION_BUILTIN) break;
5a6d7d2001-04-10Fredrik Hübinette (Hubbe)  if(func->u.object->prog == pike_trampoline_program) { struct object *o; o=((struct pike_trampoline *)func->u.object->storage)->frame->current_object; add_ref(o); pop_n_elems(args); push_object(o); return; }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(*func, T_OBJECT, 0, object, func->u.object);
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  return;
5a6d7d2001-04-10Fredrik Hübinette (Hubbe)  default: SIMPLE_BAD_ARG_ERROR("function_object",1,"function");
1c1c5e2001-04-08Fredrik Hübinette (Hubbe)  } pop_n_elems(args); push_int(0); }
6410612003-01-08Henrik Grubbström (Grubba) /*! @decl program function_program(function|program f) *! *! Return the program the function @[f] is in. *!
cbe8c92003-04-07Martin Nilsson  *! If @[f] is a global function defined in the runtime @expr{0@} *! (zero) will be returned.
6410612003-01-08Henrik Grubbström (Grubba)  *! *! @seealso *! @[function_name()], @[function_object()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
6410612003-01-08Henrik Grubbström (Grubba) PIKEFUN program function_program(program|function func) efun; optflags OPT_TRY_OPTIMIZE; {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*func))
6410612003-01-08Henrik Grubbström (Grubba)  { 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;
017b572011-10-28Henrik Grubbström (Grubba)  if(SUBTYPEOF(*func) == FUNCTION_BUILTIN)
48a6242003-05-31Martin Stjernholm  p = func->u.efun->prog; else p = func->u.object->prog;
6410612003-01-08Henrik Grubbström (Grubba)  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); }
1c1c5e2001-04-08Fredrik Hübinette (Hubbe) 
18c2252003-04-10Martin Nilsson /*! @decl mixed random(object o) *! If random is called with an object, @[lfun::random] will be *! called in the object.
e24c3d2013-11-18Henrik Grubbström (Grubba)  *!
d95fa82001-06-05Fredrik Hübinette (Hubbe)  *! @seealso
e24c3d2013-11-18Henrik Grubbström (Grubba)  *! @[lfun::_random()]
18c2252003-04-10Martin Nilsson  */
e1b4192001-06-06Fredrik Hübinette (Hubbe) 
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN mixed random(object o)
d95fa82001-06-05Fredrik Hübinette (Hubbe)  efun; optflags OPT_TRY_OPTIMIZE|OPT_EXTERNAL_DEPEND; {
e24c3d2013-11-18Henrik Grubbström (Grubba)  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);
e1b4192001-06-06Fredrik Hübinette (Hubbe)  stack_swap(); pop_stack(); }
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
18c2252003-04-10Martin Nilsson /*! @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()] */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN int random(int i) { if(i <= 0) RETURN 0;
0311712013-06-17Martin Nilsson #if SIZEOF_INT_TYPE > 4
5e424b2010-03-23Henrik Grubbström (Grubba)  if(i >> 31) { unsigned INT_TYPE a = my_rand(); unsigned INT_TYPE b = my_rand(); RETURN (INT_TYPE)(((a<<32)|b) % i); } #endif
e1b4192001-06-06Fredrik Hübinette (Hubbe)  RETURN my_rand() % i; }
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN float random(float f) { if(f<=0.0) RETURN 0.0;
d95fa82001-06-05Fredrik Hübinette (Hubbe) #define N 1048576
e1b4192001-06-06Fredrik Hübinette (Hubbe)  RETURN f * (my_rand()%N/((float)N)) + f * (my_rand()%N/( ((float)N) * ((float)N) ));
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
e1b4192001-06-06Fredrik Hübinette (Hubbe) }
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
7867852004-03-02Martin Nilsson /*! @decl mixed random(array|multiset x)
18c2252003-04-10Martin Nilsson  *! Returns a random element from @[x]. */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN mixed random(array a)
3a2fe12004-02-14Martin Nilsson  rawtype tFunc(tArr(tSetvar(0,tMix)),tVar(0));
e1b4192001-06-06Fredrik Hübinette (Hubbe) { 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(); }
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
e1b4192001-06-06Fredrik Hübinette (Hubbe) PIKEFUN mixed random(multiset m)
3a2fe12004-02-14Martin Nilsson  rawtype tFunc(tSet(tSetvar(1,tMix)),tVar(1));
e1b4192001-06-06Fredrik Hübinette (Hubbe) {
5b15bb2001-12-10Martin Stjernholm  if(multiset_is_empty (m))
e1b4192001-06-06Fredrik Hübinette (Hubbe)  SIMPLE_BAD_ARG_ERROR("random", 1, "multiset with elements in it");
5b15bb2001-12-10Martin Stjernholm  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 {
eb82b82004-04-06Martin Nilsson  push_multiset_index (m, multiset_get_nth (m, my_rand() % multiset_sizeof (m)));
5b15bb2001-12-10Martin Stjernholm  sub_msnode_ref (m); }
e1b4192001-06-06Fredrik Hübinette (Hubbe)  stack_swap(); pop_stack(); }
d95fa82001-06-05Fredrik Hübinette (Hubbe) 
18c2252003-04-10Martin Nilsson /*! @decl array random(mapping m) *! Returns a random index-value pair from the mapping. */
28ab1d2006-07-05Martin Stjernholm PMOD_EXPORT
5b15bb2001-12-10Martin Stjernholm PIKEFUN array random(mapping m)
e1b4192001-06-06Fredrik Hübinette (Hubbe) { struct mapping_data *md=m->data; size_t bucket, count; struct keypair *k; if(!m_sizeof(m)) SIMPLE_BAD_ARG_ERROR("random", 1, "mapping with elements in it"); /* Find a random, nonempty bucket */ bucket=my_rand() % md->hashsize; while(! md->hash[bucket] ) if(++bucket > (size_t)md->hashsize) bucket=0; /* Count entries in bucket */ count=0; for(k=md->hash[bucket];k;k=k->next) count++; /* Select a random entry in this bucket */ count = my_rand() % count; k=md->hash[bucket]; while(count-- > 0) k=k->next; /* Push result and return */ push_svalue(&k->ind); push_svalue(&k->val); f_aggregate(2); stack_swap(); pop_stack();
d95fa82001-06-05Fredrik Hübinette (Hubbe) }
687af42008-07-08Henrik Grubbström (Grubba) #if defined(HAVE_SETENV) && defined(HAVE_UNSETENV) #define USE_SETENV #else
8d401b2008-06-05Martin Stjernholm /* Used to hold refs to the strings that we feed to putenv. Indexed on
687af42008-07-08Henrik Grubbström (Grubba)  * variable names, values are the "name=value" strings. * * This is not needed when using {,un}setenv(), since they maintain * their own corresponding table. */
8d401b2008-06-05Martin Stjernholm static struct mapping *env_allocs = NULL;
687af42008-07-08Henrik Grubbström (Grubba) #endif
8d401b2008-06-05Martin Stjernholm  /* 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 {
5aa54c2014-09-03Martin Nilsson  char *eq = strchr (entry, '=');
8d401b2008-06-05Martin Stjernholm  /* 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);
687af42008-07-08Henrik Grubbström (Grubba) #ifndef USE_SETENV
8d401b2008-06-05Martin Stjernholm  if (env_allocs) new_env_allocs = allocate_mapping (m_sizeof (env_allocs));
687af42008-07-08Henrik Grubbström (Grubba) #endif /* !USE_SETENV */
8d401b2008-06-05Martin Stjernholm  while (--n >= 0) {
5aa54c2014-09-03Martin Nilsson  char *entry = environ[n], *eq = strchr (entry, '=');
8d401b2008-06-05Martin Stjernholm  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);
687af42008-07-08Henrik Grubbström (Grubba) #ifndef USE_SETENV
8d401b2008-06-05Martin Stjernholm  /* 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); }
687af42008-07-08Henrik Grubbström (Grubba) #endif /* !USE_SETENV */
8d401b2008-06-05Martin Stjernholm  free_string (var); free_string (val); } }
687af42008-07-08Henrik Grubbström (Grubba) #ifndef USE_SETENV
8d401b2008-06-05Martin Stjernholm  if (env_allocs) { free_mapping (env_allocs); env_allocs = new_env_allocs; }
687af42008-07-08Henrik Grubbström (Grubba) #endif /* !USE_SETENV */
8d401b2008-06-05Martin Stjernholm  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) {
687af42008-07-08Henrik Grubbström (Grubba) #ifndef USE_SETENV
8d401b2008-06-05Martin Stjernholm  struct pike_string *putenv_str, *env_alloc_var;
687af42008-07-08Henrik Grubbström (Grubba) #endif
8d401b2008-06-05Martin Stjernholm  if (var->size_shift) SIMPLE_ARG_TYPE_ERROR ("putenv", 1, "string(0..255)");
5aa54c2014-09-03Martin Nilsson  if (string_has_null (var) || strchr (var->str, '='))
8d401b2008-06-05Martin Stjernholm  SIMPLE_ARG_ERROR ("putenv", 1, "Variable name cannot contain '=' or NUL."); if (val) {
687af42008-07-08Henrik Grubbström (Grubba) #ifndef USE_SETENV
8d401b2008-06-05Martin Stjernholm  struct string_builder sb;
687af42008-07-08Henrik Grubbström (Grubba) #endif
8d401b2008-06-05Martin Stjernholm  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.");
687af42008-07-08Henrik Grubbström (Grubba) #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 */
8d401b2008-06-05Martin Stjernholm  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. */
687af42008-07-08Henrik Grubbström (Grubba) #endif /* USE_SETENV */
8d401b2008-06-05Martin Stjernholm  }
0654322008-06-10Martin Stjernholm  else {
687af42008-07-08Henrik Grubbström (Grubba) #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 */
0654322008-06-10Martin Stjernholm #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
8d401b2008-06-05Martin Stjernholm  putenv_str = var;
0654322008-06-10Martin Stjernholm #endif
687af42008-07-08Henrik Grubbström (Grubba) #endif /* USE_SETENV */
0654322008-06-10Martin Stjernholm  }
8d401b2008-06-05Martin Stjernholm 
687af42008-07-08Henrik Grubbström (Grubba) #ifndef USE_SETENV
6c15cb2008-06-10Martin Stjernholm  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)); }
8d401b2008-06-05Martin Stjernholm  #ifdef __NT__ ref_push_string (var); f_lower_case (1);
017b572011-10-28Henrik Grubbström (Grubba)  assert (TYPEOF(Pike_sp[-1]) == T_STRING);
8d401b2008-06-05Martin Stjernholm  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;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(key, T_STRING, 0, string, env_alloc_var);
8d401b2008-06-05Martin Stjernholm  map_delete (env_allocs, &key); }
687af42008-07-08Henrik Grubbström (Grubba) #endif /* !USE_SETENV */
8d401b2008-06-05Martin Stjernholm }
f1d1aa2012-07-13Henrik Grubbström (Grubba) #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 */
d27df52001-06-18Henrik Grubbström (Grubba) /* * Backtrace handling. */
bcbce02001-08-15Martin Nilsson /*! @module Pike */
d27df52001-06-18Henrik Grubbström (Grubba) /*! @class BacktraceFrame */ PIKECLASS backtrace_frame {
e044e22009-06-24Henrik Grubbström (Grubba)  PIKEVAR mixed _fun flags ID_PROTECTED|ID_PRIVATE; #ifdef PIKE_DEBUG PIKEVAR program oprog flags ID_PROTECTED|ID_PRIVATE; #endif
2aca9f2001-06-19Henrik Grubbström (Grubba)  PIKEVAR array args;
73b08f2003-01-31Martin Stjernholm 
e044e22009-06-24Henrik Grubbström (Grubba)  /* These are cleared when filename and lineno have been initialized
73b08f2003-01-31Martin Stjernholm  * from them. */
95489a2008-06-29Martin Nilsson  PIKEVAR program prog flags ID_PROTECTED|ID_PRIVATE;
90f8762002-04-08Martin Stjernholm  CVAR PIKE_OPCODE_T *pc;
73b08f2003-01-31Martin Stjernholm  /* These two are considered to be uninitialized from prog, pc and * fun as long as lineno == -1. */
d27df52001-06-18Henrik Grubbström (Grubba)  CVAR struct pike_string *filename;
ef24a82012-01-12Henrik Grubbström (Grubba)  CVAR INT_TYPE lineno;
d27df52001-06-18Henrik Grubbström (Grubba)  INIT {
90f8762002-04-08Martin Stjernholm  THIS->pc = NULL;
73b08f2003-01-31Martin Stjernholm  THIS->lineno = -1;
0f47db2001-06-19Henrik Grubbström (Grubba)  THIS->filename = NULL;
d27df52001-06-18Henrik Grubbström (Grubba)  } EXIT
8dcb7d2008-05-29Martin Stjernholm  gc_trivial;
d27df52001-06-18Henrik Grubbström (Grubba)  { if (THIS->filename) { free_string(THIS->filename);
0f47db2001-06-19Henrik Grubbström (Grubba)  THIS->filename = NULL;
d27df52001-06-18Henrik Grubbström (Grubba)  }
1073bf2001-06-26Henrik Grubbström (Grubba)  THIS->pc = NULL;
73b08f2003-01-31Martin Stjernholm  THIS->lineno = -1;
d27df52001-06-18Henrik Grubbström (Grubba)  }
4452172009-06-25Henrik Grubbström (Grubba)  /* NOTE: Use old-style getter/setter syntax for compatibility with * old Parser.Pike.split() used by precompile.pike. */ PIKEFUN mixed `->fun()
e044e22009-06-24Henrik Grubbström (Grubba)  { push_svalue(&THIS->_fun); }
513e2c2009-06-25Henrik Grubbström (Grubba)  PIKEFUN void `->fun=(mixed val)
e044e22009-06-24Henrik Grubbström (Grubba)  { /* FIXME: Should we allow this at all? * Linenumber info etc won't match. */ #ifdef PIKE_DEBUG
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(*val) == T_FUNCTION) && (SUBTYPEOF(*val) != FUNCTION_BUILTIN)) {
e044e22009-06-24Henrik Grubbström (Grubba)  assign_short_svalue((union anything *)&THIS->oprog, (union anything *)&val->u.object->prog, T_PROGRAM); } #endif assign_svalue(&THIS->_fun, val); }
18c2252003-04-10Martin Nilsson  /*! @decl int(0..1) _is_type(string t) *! This object claims to be an array for backward compatibility. */
d2cd4e2001-06-18Henrik Grubbström (Grubba)  PIKEFUN int(0..1) _is_type(string t) { INT_TYPE res = (t == findstring("array")); pop_n_elems(args); push_int(res); }
73b08f2003-01-31Martin Stjernholm  static void fill_in_file_and_line() {
0469ba2004-02-10Martin Stjernholm  struct pike_string *file = NULL;
73b08f2003-01-31Martin Stjernholm  assert (THIS->lineno == -1); if (THIS->pc && THIS->prog) { file = low_get_line(THIS->pc, THIS->prog, &THIS->lineno); THIS->pc = NULL; }
017b572011-10-28Henrik Grubbström (Grubba)  else if (TYPEOF(THIS->_fun) == PIKE_T_FUNCTION) {
e044e22009-06-24Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (THIS->_fun.u.object->prog && THIS->_fun.u.object->prog != THIS->oprog) {
017b572011-10-28Henrik Grubbström (Grubba)  struct identifier *id = ID_FROM_INT(THIS->oprog, SUBTYPEOF(THIS->_fun));
e044e22009-06-24Henrik Grubbström (Grubba)  /* 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
017b572011-10-28Henrik Grubbström (Grubba)  file = low_get_function_line (THIS->_fun.u.object, SUBTYPEOF(THIS->_fun),
73b08f2003-01-31Martin Stjernholm  &THIS->lineno);
d191622006-03-22Henrik Grubbström (Grubba)  } else if (THIS->prog) {
73b08f2003-01-31Martin Stjernholm  file = low_get_program_line (THIS->prog, &THIS->lineno);
d191622006-03-22Henrik Grubbström (Grubba)  }
73b08f2003-01-31Martin Stjernholm 
0469ba2004-02-10Martin Stjernholm  if (file) { if (!THIS->filename) THIS->filename = file; else free_string (file); }
73b08f2003-01-31Martin Stjernholm  if (THIS->prog) { free_program(THIS->prog); THIS->prog = NULL; } }
18c2252003-04-10Martin Nilsson  /*! @decl string _sprintf(int c, mapping|void opts) */
d27df52001-06-18Henrik Grubbström (Grubba)  PIKEFUN string _sprintf(int c, mapping|void opts) { pop_n_elems(args);
e6dbc22002-11-29Marcus Comstedt  if (c != 'O') { push_undefined (); return; }
d27df52001-06-18Henrik Grubbström (Grubba)  push_text("backtrace_frame(");
73b08f2003-01-31Martin Stjernholm  if (THIS->lineno == -1) fill_in_file_and_line();
1073bf2001-06-26Henrik Grubbström (Grubba)  if (THIS->filename) {
d27df52001-06-18Henrik Grubbström (Grubba)  ref_push_string(THIS->filename); push_text(":"); push_int(THIS->lineno); push_text(", "); f_add(4); } else { push_text("Unknown file, "); }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(THIS->_fun) == PIKE_T_FUNCTION) {
e044e22009-06-24Henrik Grubbström (Grubba)  if (THIS->_fun.u.object->prog) { #ifdef PIKE_DEBUG if (THIS->_fun.u.object->prog != THIS->oprog) {
017b572011-10-28Henrik Grubbström (Grubba)  struct identifier *id = ID_FROM_INT(THIS->oprog, SUBTYPEOF(THIS->_fun));
e044e22009-06-24Henrik Grubbström (Grubba)  /* 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);
0f47db2001-06-19Henrik Grubbström (Grubba)  f_function_name(1); push_text("(), "); f_add(2); } else {
e044e22009-06-24Henrik Grubbström (Grubba)  free_svalue(&THIS->_fun);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(THIS->_fun, PIKE_T_INT, NUMBER_DESTRUCTED, integer, 0);
0f47db2001-06-19Henrik Grubbström (Grubba)  push_text("destructed_function(), "); }
fac36c2012-01-16Henrik Grubbström (Grubba)  } else if (TYPEOF(THIS->_fun) == PIKE_T_PROGRAM) { /* FIXME: Use the master? */ push_text("program(), ");
42d5b32012-01-09Henrik Grubbström (Grubba)  } else if (TYPEOF(THIS->_fun) == PIKE_T_STRING) { push_svalue(&THIS->_fun); push_text("(), "); f_add(2);
d27df52001-06-18Henrik Grubbström (Grubba)  } else { push_text("destructed_function(), "); }
0f47db2001-06-19Henrik Grubbström (Grubba)  if (THIS->args) {
d27df52001-06-18Henrik Grubbström (Grubba)  push_text("Args: ");
0f47db2001-06-19Henrik Grubbström (Grubba)  push_int(THIS->args->size);
d27df52001-06-18Henrik Grubbström (Grubba)  f_add(2); } else { push_text("No args"); } push_text(")"); f_add(5); }
18c2252003-04-10Martin Nilsson  /*! @decl int(3..) _sizeof() */ PIKEFUN int(3..) _sizeof()
d27df52001-06-18Henrik Grubbström (Grubba)  {
0f47db2001-06-19Henrik Grubbström (Grubba)  if (THIS->args) { push_int(THIS->args->size + 3); } else { push_int(3);
d27df52001-06-18Henrik Grubbström (Grubba)  } }
18c2252003-04-10Martin Nilsson  /*! @decl mixed `[](int index, int|void end_or_none) *! The BacktraceFrame object can be indexed as an array. */
d2cd4e2001-06-18Henrik Grubbström (Grubba)  PIKEFUN mixed `[](int index, int|void end_or_none)
d27df52001-06-18Henrik Grubbström (Grubba)  {
d2cd4e2001-06-18Henrik Grubbström (Grubba)  INT_TYPE end = index;
d398fc2014-08-25Stephen R. van den Berg  INT32 numargs = 3;
d2cd4e2001-06-18Henrik Grubbström (Grubba)  INT32 i;
d398fc2014-08-25Stephen R. van den Berg  if (THIS->args) numargs += THIS->args->size;
d2cd4e2001-06-18Henrik Grubbström (Grubba)  if (!end_or_none) {
d398fc2014-08-25Stephen R. van den Berg  if (index < 0)
d2cd4e2001-06-18Henrik Grubbström (Grubba)  index_error("pike_frame->`[]", Pike_sp-args, args, NULL, Pike_sp-args, "Indexing with negative index (%"PRINTPIKEINT"d)\n", index);
d398fc2014-08-25Stephen R. van den Berg  else if (index >= numargs)
d2cd4e2001-06-18Henrik Grubbström (Grubba)  index_error("pike_frame->`[]", Pike_sp-args, args, NULL, Pike_sp-args, "Indexing with too large index (%"PRINTPIKEINT"d)\n", index);
d398fc2014-08-25Stephen R. van den Berg  } else
d2cd4e2001-06-18Henrik Grubbström (Grubba)  end = end_or_none->u.integer;
d27df52001-06-18Henrik Grubbström (Grubba)  pop_n_elems(args);
d2cd4e2001-06-18Henrik Grubbström (Grubba)  if (end_or_none) {
0f47db2001-06-19Henrik Grubbström (Grubba)  if ((end < 0) || (end < index) || (index >= numargs)) {
d2cd4e2001-06-18Henrik Grubbström (Grubba)  f_aggregate(0); return;
d27df52001-06-18Henrik Grubbström (Grubba)  }
d2cd4e2001-06-18Henrik Grubbström (Grubba) 
5929f32014-08-25Stephen R. van den Berg  if (end >= numargs)
d2cd4e2001-06-18Henrik Grubbström (Grubba)  end = numargs-1; } for (i = index; i <= end; i++) { switch(i) { case 0: /* Filename */
73b08f2003-01-31Martin Stjernholm  if (THIS->lineno == -1) fill_in_file_and_line();
5929f32014-08-25Stephen R. van den Berg  if (THIS->filename)
73b08f2003-01-31Martin Stjernholm  ref_push_string(THIS->filename);
5929f32014-08-25Stephen R. van den Berg  else
73b08f2003-01-31Martin Stjernholm  push_int(0);
1073bf2001-06-26Henrik Grubbström (Grubba)  break;
73b08f2003-01-31Martin Stjernholm  case 1: /* Linenumber */ if (THIS->lineno == -1) fill_in_file_and_line(); push_int(THIS->lineno); break;
d2cd4e2001-06-18Henrik Grubbström (Grubba)  case 2: /* Function */
e044e22009-06-24Henrik Grubbström (Grubba)  push_svalue(&THIS->_fun);
d2cd4e2001-06-18Henrik Grubbström (Grubba)  break; default: /* Arguments */ {
0f47db2001-06-19Henrik Grubbström (Grubba)  if ((i > 2) && (THIS->args) && (i-3 < THIS->args->size)) { push_svalue(THIS->args->item + (i - 3));
d2cd4e2001-06-18Henrik Grubbström (Grubba)  break; }
de22f72014-08-25Martin Nilsson  bad_arg_error("`[]", Pike_sp-args, args, 1,
d2cd4e2001-06-18Henrik Grubbström (Grubba)  "int(0..)", Pike_sp-args, "Bad argument 1 to backtrace_frame->`[](): " "Expected int(0..%d)\n", numargs + 2); } /* NOT_REACHED */ break;
d27df52001-06-18Henrik Grubbström (Grubba)  }
d2cd4e2001-06-18Henrik Grubbström (Grubba)  }
5929f32014-08-25Stephen R. van den Berg  if (end_or_none)
d2cd4e2001-06-18Henrik Grubbström (Grubba)  f_aggregate(1 + end - index);
d27df52001-06-18Henrik Grubbström (Grubba)  }
d2cd4e2001-06-18Henrik Grubbström (Grubba) 
18c2252003-04-10Martin Nilsson  /*! @decl mixed `[]=(int index, mixed value) */
1073bf2001-06-26Henrik Grubbström (Grubba)  PIKEFUN mixed `[]=(int index, mixed value) {
5929f32014-08-25Stephen R. van den Berg  INT32 numargs = 3;
1073bf2001-06-26Henrik Grubbström (Grubba) 
5929f32014-08-25Stephen R. van den Berg  if (THIS->args) numargs += THIS->args->size;
1073bf2001-06-26Henrik Grubbström (Grubba) 
5929f32014-08-25Stephen R. van den Berg  if ((index < -numargs) || (index >= numargs))
1073bf2001-06-26Henrik Grubbström (Grubba)  index_error("pike_frame->`[]=", Pike_sp-args, args, NULL, Pike_sp-args,
b99d882003-05-15Martin Stjernholm  "Index %"PRINTPIKEINT"d is out of array range 0..%d,\n",
1073bf2001-06-26Henrik Grubbström (Grubba)  index, numargs-1);
5929f32014-08-25Stephen R. van den Berg  else if (index < 0)
1073bf2001-06-26Henrik Grubbström (Grubba)  index += numargs; if (args > 2) { pop_n_elems(args - 2); args = 2; } switch(index) { case 0: /* Filename */
73b08f2003-01-31Martin Stjernholm  if (THIS->lineno == -1) fill_in_file_and_line();
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*value) != PIKE_T_STRING) { if ((TYPEOF(*value) != PIKE_T_INT) ||
73b08f2003-01-31Martin Stjernholm  (value->u.integer)) {
de22f72014-08-25Martin Nilsson  SIMPLE_BAD_ARG_ERROR("`[]=", 2, "string|int(0..0)");
1073bf2001-06-26Henrik Grubbström (Grubba)  }
73b08f2003-01-31Martin Stjernholm  if (THIS->filename) { free_string(THIS->filename); THIS->filename = NULL;
1073bf2001-06-26Henrik Grubbström (Grubba)  } } else {
73b08f2003-01-31Martin Stjernholm  if (THIS->filename) { free_string(THIS->filename); THIS->filename = NULL;
1073bf2001-06-26Henrik Grubbström (Grubba)  }
73b08f2003-01-31Martin Stjernholm  copy_shared_string(THIS->filename, value->u.string);
1073bf2001-06-26Henrik Grubbström (Grubba)  } break;
73b08f2003-01-31Martin Stjernholm  case 1: /* Linenumber */ if (THIS->lineno == -1) fill_in_file_and_line();
5929f32014-08-25Stephen R. van den Berg  if (TYPEOF(*value) != PIKE_T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_BAD_ARG_ERROR("`[]=", 2, "int(1..)");
73b08f2003-01-31Martin Stjernholm  THIS->lineno = value->u.integer; break;
1073bf2001-06-26Henrik Grubbström (Grubba)  case 2: /* Function */
73b08f2003-01-31Martin Stjernholm  if (THIS->lineno == -1) fill_in_file_and_line();
e044e22009-06-24Henrik Grubbström (Grubba)  assign_svalue(&THIS->_fun, value);
1073bf2001-06-26Henrik Grubbström (Grubba)  break; default: /* Arguments */ assign_svalue(THIS->args->item + index - 3, value); break; } stack_swap(); pop_stack(); }
d27df52001-06-18Henrik Grubbström (Grubba) }; /*! @endclass */
5809812006-03-25Henrik Grubbström (Grubba) /*! @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.
6c9f492006-04-22Henrik Grubbström (Grubba)  *! Usually @expr{1234@} (aka little endian) or *! @expr{4321@} (aka bigendian).
5809812006-03-25Henrik Grubbström (Grubba)  *! @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);
7cf0162014-05-22Per Hedbor  push_text("bytecode_method"); push_text(PIKE_BYTECODE_METHOD_NAME); push_text("abi");
5809812006-03-25Henrik Grubbström (Grubba)  push_int(sizeof(void *) * 8);
7cf0162014-05-22Per Hedbor  push_text("native_byteorder");
5809812006-03-25Henrik Grubbström (Grubba)  push_int(PIKE_BYTEORDER);
7cf0162014-05-22Per Hedbor  push_text("int_size");
5809812006-03-25Henrik Grubbström (Grubba)  push_int(sizeof(INT_TYPE) * 8);
7cf0162014-05-22Per Hedbor  push_text("float_size");
5809812006-03-25Henrik Grubbström (Grubba)  push_int(sizeof(FLOAT_TYPE) * 8);
7cf0162014-05-22Per Hedbor  push_text("auto_bignum");
5809812006-03-25Henrik Grubbström (Grubba)  push_int(1); f_aggregate_mapping(6*2); }
bcbce02001-08-15Martin Nilsson /*! @endmodule */
d97eb72011-07-10Henrik Grubbström (Grubba) void low_backtrace(struct Pike_interpreter_struct *i)
d27df52001-06-18Henrik Grubbström (Grubba) {
b85fa02003-02-24Martin Stjernholm  struct svalue *stack_top = i->stack_pointer;
c98dd22001-06-26Martin Stjernholm  struct pike_frame *f, *of = 0;
d27df52001-06-18Henrik Grubbström (Grubba)  int size = 0;
9906e32001-06-20Henrik Grubbström (Grubba)  struct array *res = NULL;
d27df52001-06-18Henrik Grubbström (Grubba) 
a8e9892001-09-05Fredrik Hübinette (Hubbe)  for (f = i->frame_pointer; f; f = f->next) {
9906e32001-06-20Henrik Grubbström (Grubba)  size++; } res = allocate_array_no_init(size, 0); push_array(res);
a8e9892001-09-05Fredrik Hübinette (Hubbe)  for (f = i->frame_pointer; f && size; f = (of = f)->next) {
d27df52001-06-18Henrik Grubbström (Grubba)  struct object *o = low_clone(backtrace_frame_program);
0f47db2001-06-19Henrik Grubbström (Grubba)  struct backtrace_frame_struct *bf;
e89d722002-01-04Henrik Grubbström (Grubba)  struct identifier *function = NULL;
0f47db2001-06-19Henrik Grubbström (Grubba) 
d27df52001-06-18Henrik Grubbström (Grubba)  call_c_initializers(o);
0f47db2001-06-19Henrik Grubbström (Grubba) 
9906e32001-06-20Henrik Grubbström (Grubba)  size--;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(res->item[size], PIKE_T_OBJECT, 0, object, o);
9906e32001-06-20Henrik Grubbström (Grubba) 
0f47db2001-06-19Henrik Grubbström (Grubba)  bf = OBJ2_BACKTRACE_FRAME(o);
fa93a52008-02-28Henrik Grubbström (Grubba)  if ((bf->prog = f->context->prog)) {
0f47db2001-06-19Henrik Grubbström (Grubba)  add_ref(bf->prog);
df4fe22006-03-22Henrik Grubbström (Grubba)  bf->pc = f->pc;
0f47db2001-06-19Henrik Grubbström (Grubba)  }
42d5b32012-01-09Henrik Grubbström (Grubba)  SET_SVAL(bf->_fun, PIKE_T_INT, NUMBER_DESTRUCTED, integer, 0);
017b572011-10-28Henrik Grubbström (Grubba)  if (f->current_object && f->current_object->prog) {
42d5b32012-01-09Henrik Grubbström (Grubba)  if (f->fun == FUNCTION_BUILTIN) { /* Unusual case. The frame is from call_c_initializers(), gc() * or similar. cf [bug 6156]. /grubba
fac36c2012-01-16Henrik Grubbström (Grubba)  * * Masquerade as the program. * * FIXME: Ought to keep parent-pointers.
42d5b32012-01-09Henrik Grubbström (Grubba)  */
fac36c2012-01-16Henrik Grubbström (Grubba)  SET_SVAL(bf->_fun, PIKE_T_PROGRAM, 0, program, f->current_object->prog); add_ref(f->current_object->prog);
42d5b32012-01-09Henrik Grubbström (Grubba)  } else { SET_SVAL(bf->_fun, PIKE_T_FUNCTION, CHECK_IDREF_RANGE(f->fun, f->current_object->prog), object, f->current_object); add_ref(f->current_object); function = ID_FROM_INT(f->current_object->prog, f->fun);
e044e22009-06-24Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG
42d5b32012-01-09Henrik Grubbström (Grubba)  add_ref(bf->oprog = bf->_fun.u.object->prog);
e044e22009-06-24Henrik Grubbström (Grubba) #endif
42d5b32012-01-09Henrik Grubbström (Grubba)  }
0f47db2001-06-19Henrik Grubbström (Grubba)  } if (f->locals) { INT32 numargs = DO_NOT_WARN((INT32) MINIMUM(f->num_args,
b85fa02003-02-24Martin Stjernholm  stack_top - f->locals));
e89d722002-01-04Henrik Grubbström (Grubba)  INT32 varargs = 0;
a70d642008-05-28Martin Stjernholm  if(of && of->locals) {
c98dd22001-06-26Martin Stjernholm  /* f->num_args can be too large, so this is necessary for some
01f9142013-08-01Arne Goedeke  * reason. I don't know why. /mast * * possibly because f->num_args was uninitialized for c_initializers * /arne * */
c98dd22001-06-26Martin Stjernholm  numargs = DO_NOT_WARN((INT32)MINIMUM(f->num_args,of->locals - f->locals));
da90692002-11-26Henrik Grubbström (Grubba)  }
0f47db2001-06-19Henrik Grubbström (Grubba)  numargs = MAXIMUM(numargs, 0);
e89d722002-01-04Henrik Grubbström (Grubba)  /* Handle varargs... */ if (function && (function->identifier_flags & IDENTIFIER_VARARGS) &&
b85fa02003-02-24Martin Stjernholm  (f->locals + numargs < stack_top) &&
017b572011-10-28Henrik Grubbström (Grubba)  (TYPEOF(f->locals[numargs]) == T_ARRAY)) {
e89d722002-01-04Henrik Grubbström (Grubba)  varargs = f->locals[numargs].u.array->size; } if (numargs + varargs) { bf->args = allocate_array_no_init(numargs + varargs, 0);
2523ce2003-04-28Martin Stjernholm  bf->args->type_field = assign_svalues_no_free(bf->args->item, f->locals, numargs, BIT_MIXED);
e89d722002-01-04Henrik Grubbström (Grubba)  if (varargs) {
2523ce2003-04-28Martin Stjernholm  bf->args->type_field |= assign_svalues_no_free(bf->args->item + numargs, f->locals[numargs].u.array->item, varargs, BIT_MIXED);
e89d722002-01-04Henrik Grubbström (Grubba)  }
0f47db2001-06-19Henrik Grubbström (Grubba)  } }
d27df52001-06-18Henrik Grubbström (Grubba)  }
2523ce2003-04-28Martin Stjernholm  res->type_field = BIT_OBJECT;
9906e32001-06-20Henrik Grubbström (Grubba)  /* NOTE: res has already been pushed on the stack. */
d27df52001-06-18Henrik Grubbström (Grubba) }
e1b4192001-06-06Fredrik Hübinette (Hubbe) 
a8e9892001-09-05Fredrik Hübinette (Hubbe) /*! @decl array(Pike.BacktraceFrame) backtrace() *! *! FIXME: This documentation is not up to date! *! *! Get a description of the current call stack. *! *! The description is returned as an array with one entry for each call *! frame on the stack. *! *! Each entry has this format: *! @array *! @elem string file *! A string with the filename if known, else zero. *! @elem int line *! An integer containing the linenumber if known, else zero. *! @elem function fun *! The function that was called at this level. *! @elem mixed|void ... args *! The arguments that the function was called with. *! @endarray *! *! The current call frame will be last in the array. *! *! @note *! Please note that the frame order may be reversed in a later version
c717042003-03-12Marcus Agehall  *! (than 7.1) of Pike to accommodate for deferred backtraces.
a8e9892001-09-05Fredrik Hübinette (Hubbe)  *! *! 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); }
a3c4332001-06-20Per Hedbor /*! @module String */ /*! @class Buffer *! A buffer, used for building strings. It's
40592f2014-08-26Stephen R. van den Berg  *! conceptually similar to a string, but speed-optimised for growing *! strings.
a3c4332001-06-20Per Hedbor  *! *! 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: *!
f79bd82003-04-01Martin Nilsson  *! @code *! String.Buffer b = String.Buffer( );
a3c4332001-06-20Per Hedbor  *!
f79bd82003-04-01Martin Nilsson  *! function add = b->add;
a3c4332001-06-20Per Hedbor  *!
f79bd82003-04-01Martin Nilsson  *! .. call add several times in code ...
a3c4332001-06-20Per Hedbor  *!
f79bd82003-04-01Martin Nilsson  *! string result = b->get(); // also clears the buffer *! @endcode
a3c4332001-06-20Per Hedbor  */
41730d2001-07-26Martin Nilsson PIKECLASS Buffer
a3c4332001-06-20Per Hedbor {
fdea8d2014-09-09Stephen R. van den Berg  CVAR struct string_builder str; /* Can be empty */ CVAR char* buffer; /* Current start of the buffer */ CVAR size_t offset; /* Characters consumed but still in the buffer */ CVAR size_t len; /* Number of characters available to be read */ CVAR unsigned shift; /* Current size_shift of the buffer */ CVAR unsigned readonly; /* If the buffer is marked readonly */ CVAR size_t initial; /* Initial reserved (unfilled) buffersize */
e950862014-08-29Stephen R. van den Berg  CVAR struct object *source; /* CVAR program *error_mode; */ CVAR unsigned error_mode; static INLINE unsigned min_magnitude(const unsigned c) { return c<256 ? 0 : c<65536 ? 1 : 2; } static int buffer_range_error(int howmuch) { if( THIS->error_mode ) Pike_error("Trying to read %d outside allowed range\n", howmuch); return 0; } static struct pike_string*buffer_mkspace(ptrdiff_t diff, unsigned shift) { struct Buffer_struct *str = THIS; struct pike_string *s = str->str.s; if (str->readonly) Pike_error("Attempt to modify readonly buffer.\n"); if (!s || s->refs!=1) { shift |= str->shift; shift = shift & ~(shift >> 1); init_string_builder_alloc(&str->str, str->len+diff, shift); generic_memcpy(MKPCHARP(str->str.s->str, shift), MKPCHARP(str->buffer, str->shift), str->len); if (s) sub_ref(s); str->offset = 0; goto fixptr; } else { if (!(s->flags & STRING_NOT_SHARED)) unlink_pike_string (s); string_build_mkspace(&str->str, diff, shift); fixptr: s = str->str.s; str->buffer = s->str + (str->offset << (str->shift = s->size_shift)); } if( str->source ) { free_object( str->source ); str->source = 0; } return s; } static void buffer_lock() { THIS->readonly++; } static void buffer_release() { THIS->readonly--; }
2687f92013-09-20Per Hedbor  PIKEFUN int _size_object() {
e950862014-08-29Stephen R. van den Berg  struct Buffer_struct *str = THIS; unsigned retval = 0; if (str->str.s) { retval = str->str.s->refs; retval = (str->str.malloced+retval-1)/retval; } push_int( retval ); } /*! @decl void set_error_mode(int m) *! *! Set the error mode of this buffer to @[m]. *! *! If true operations that would normally return 0 *! (like trying to read too much) will instead thrown an error. *! *! This is useful when parsing received data, you do not have to *! verify that each and every read operation suceeds. *! *! However, the non-error mode is more useful when checking to see *! if a packet/segment/whatever has arrived. *! *! The thrown error object will have the constant buffer_error set *! to a non-false value. *! *! @example *! @code *! void read_callback(int i, string new_data) *! { *! inbuffer->add( new_data ); *! *! while( String.Buffer packet = inbuffer->read_hbuffer(2) ) *! { *! packet->set_error_mode(Buffer.THROW_ERROR); *! if( mixed e = catch( handle_packet( packet ) ) ) *! if( e->buffer_error ) *! protocol_error(); // illegal data in packet *! else *! throw(e); // the other code did something bad *! } *! } *! *! *! void handle_packet( String.Buffer pack ) *! { *! switch( pack->read_int8() ) *! { *! ... *! case HEADER_FRAME: *! int num_headers = pack->read_int32(); *! for( int i = 0; i<num_headers; i++ ) *! headers[pack->read_hstring(2)] = pack->read_hstring(2); *! ... *! } *! } *! @endcode */ PIKEFUN void set_error_mode(int m) { /* FIXME: buffer_error and Buffer.THROW_ERROR still need to be implemented */ THIS->error_mode = m; pop_stack(); } /*! @decl protected bool range_error( int howmuch ) *! *! This function is called when an attempt is made to read out of bounds. *! The default implementation simply returnns 0. *! *! Override this function to change the behaviour *! *! The argument @[howmuch] indicates how much data is needed: *! *! @dl *! @item int(1..) howmuch *! Need @[howmuch] bytes more *! @item int(0..0) howmuch *! The amount of data needed is not certain. *! This most often happens when @[sscanf] or @[read_json] is used *! @item int(..-1) howmuch=... *! Tried to @[unread] X bytes. There is usually no way to satisfy *! the requested range. *! *! Fill the @[unread()] buffer by passing data to it, then *! @[consume()] it again. *! @enddl *! *! @returns *! *! @[true] if the operation should be retried, @[false] otherwise. *! *! Do not return true unless you have added data to the buffer, *! doing so could result in an infinite loop (since no data is *! added, the range_error will be called again immediately). */ PIKEFUN int(0..1) range_error( int howmuch ) flags ID_PROTECTED; { /* Default: throw error if so desired, otherwise return 0. */ pop_n_elems(args); push_int(0); } struct sysmem { unsigned char *p; size_t size; }; static struct program *shm_program; static struct sysmem *system_memory(struct object *o) { if( !shm_program ) { push_text("System.Memory"); SAFE_APPLY_MASTER("resolv", 1); shm_program = program_from_svalue(Pike_sp - 1); Pike_sp--; if (!shm_program) return 0; } return o->prog == shm_program ? get_storage( o, shm_program ) : 0; }; static size_t buffer_findsize(unsigned args, struct svalue*pargs, unsigned *pshift) { unsigned j,shift = 0; size_t sum = 0; for( j=args ; j-- ; ++pargs) switch(TYPEOF(*pargs)) { case PIKE_T_STRING: { struct pike_string *a = pargs->u.string; sum += a->len; shift |= a->size_shift; break; } case PIKE_T_INT: sum++; shift |= min_magnitude(pargs->u.integer); break; case PIKE_T_ARRAY: { struct array *arp = pargs->u.array; DECLARE_CYCLIC(); if (BEGIN_CYCLIC(Pike_fp->current_object, arp)) Pike_error("Attempt to append a cyclic array to a buffer.\n"); sum += buffer_findsize(arp->size, arp->item, &shift); END_CYCLIC(); break; } case PIKE_T_OBJECT: { struct sysmem *sm; if(pargs->u.object->prog == Buffer_program) { struct Buffer_struct *bstr = OBJ2_BUFFER(pargs->u.object); sum += bstr->len; shift |= bstr->shift; break; } else if (sm = system_memory(pargs->u.object)) { sum += sm->size; break; } } default: SIMPLE_BAD_ARG_ERROR("append", args-j, "string|int|String.Buffer|System.Memory" "|array(string|int|String.Buffer|System.Memory)"); } *pshift |= shift; return sum; } static char* buffer_memcpy(char*dest, unsigned shift, unsigned args, struct svalue*pargs) { unsigned j; for( j=args ; j-- ; ++pargs) { PCHARP b; size_t blen; switch(TYPEOF(*pargs)) { case PIKE_T_STRING: { struct pike_string *bs; b = MKPCHARP_STR(bs = pargs->u.string); blen = bs->len; break; } case PIKE_T_INT: { unsigned ch = pargs->u.integer; switch( shift ) { case 0: *(p_wchar0*)dest = ch; break; case 1: *(p_wchar1*)dest = ch; break; default: *(p_wchar2*)dest = ch; break; } blen = 1; goto inc; } case PIKE_T_ARRAY: { struct array *arp = pargs->u.array; dest = buffer_memcpy(dest, shift, arp->size, arp->item); continue; } default: { struct sysmem *sm; if(pargs->u.object->prog == Buffer_program) { struct Buffer_struct *bstr = OBJ2_BUFFER(pargs->u.object); b = MKPCHARP(bstr->buffer, bstr->shift); blen = bstr->len; break; } else if (sm = system_memory(pargs->u.object)) { b = MKPCHARP(sm->p, 0); blen = sm->size; break; } } } generic_memcpy(MKPCHARP(dest, shift), b, blen); inc: dest += blen<<shift; } return dest; } /*! @decl Buffer appendat(int(0..) pos, *! string|int|Buffer|object|array(string|int|Buffer|object) ... data) *! *! Adds @[data] to the buffer, starting at position @[pos]. *! It overwrites existing content at that offset, never truncates the *! buffer, possibly extends the buffer if the new content does not fit. *! *! @returns *! Returns the buffer itself. *! *! @note *! If the starting position @[pos] extends beyond the end of the *! current buffer content, the gap will be filled with NUL-characters. *! *! @seealso *! @[append()], @[add()] */ PIKEFUN Buffer appendat(int(0..) pos, string|int|Buffer|object|array(string|int|Buffer|object) ... data ) { struct Buffer_struct *str = THIS; struct svalue*pargs; struct pike_string *s; ptrdiff_t sum; int j; unsigned shift = 0; if (pos < 0) SIMPLE_BAD_ARG_ERROR("appendat", 1, "int(0..)"); args--; sum = pos + buffer_findsize(args, Pike_sp-args, &shift); shift |= str->shift; shift = shift & ~(shift >> 1); j = sum - str->len; if (j>0) { if (str->initial > j && str->initial > str->str.malloced) j = str->initial; s = buffer_mkspace(j, shift); } else s = buffer_mkspace(0, shift); /* We know it will be a string that really is this wide. */ str->str.known_shift = shift; if (str->len < pos) /* Clear the padding */ MEMSET(str->buffer + (str->len << shift), 0, (pos - str->len) << shift); { char*dest = buffer_memcpy(s->str+((pos+str->offset)<<shift), shift, args, Pike_sp-args); if (s->len < (pos = (dest - s->str)>>shift)) s->len = pos; if (str->len < (pos -= str->offset)) str->len = pos; } pop_n_elems( args+1 ); ref_push_object(Pike_fp->current_object); } /*! @decl Buffer append( *! string|int|Buffer|object|array(string|int|Buffer|object) ... data ) *! *! Adds @[data] to the buffer. *! *! @returns *! Returns the buffer itself. *! *! @seealso *! @[appendat()], @[add()] */ PIKEFUN Buffer append( string|int|Buffer|object|array(string|int|Buffer|object) ... data ) { push_int(THIS->len); stack_revroll(++args); f_Buffer_appendat(args); } /*! @decl int add( *! string|int|Buffer|object|array(string|int|Buffer|object) ... data ) *! *! Adds @[data] to the buffer. *! *! @returns *! Returns the size of the buffer. *! *! @seealso *! @[appendat()] */ PIKEFUN int add( string|int|Buffer|object|array(string|int|Buffer|object) ... data ) { f_Buffer_append(args); pop_stack(); push_int(THIS->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 Buffer_struct *str = THIS; if(str->len) { struct pike_string *s; s = make_shared_binary_pcharp(MKPCHARP(str->buffer, str->shift), str->len); if( Pike_fp->current_object->flags & OBJECT_CLEAR_ON_EXIT ) s->flags |= STRING_CLEAR_ON_EXIT; push_string(s); } else push_empty_string(); } /*! @decl string|void read(void|int n) *! *! Read and remove @[n] characters of data from the beginning *! of the buffer. *! If there are less than @[n] characters available, nothing *! will be removed and the function will return 0. *! *! When called without arguments, this is equivalent to @[get()]. *! *! @seealso *! @[get()], @[clear()] */ PIKEFUN string|void read( void|int(0..) n ) { struct Buffer_struct *str = THIS; struct pike_string *s; if (args) { int want = n->u.integer; pop_stack(); while (want<0 || want>str->len) if (!buffer_range_error( want )) { push_undefined(); return; } if (want != str->len) { push_string(make_shared_binary_pcharp( MKPCHARP(str->buffer, str->shift), want)); str->buffer += want<<=str->shift; str->offset += want; str->len -= want; return; } } buffer_mkspace(0, 0); if (str->offset) { memmove( str->str.s->str, str->buffer, str->len<<str->shift); str->str.s->len = str->len; } s = finish_string_builder( &str->str ); if( Pike_fp->current_object->flags & OBJECT_CLEAR_ON_EXIT ) s->flags |= STRING_CLEAR_ON_EXIT; push_string(s); str->str.s = 0; str->len = 0;
2687f92013-09-20Per Hedbor  }
e950862014-08-29Stephen R. van den Berg  /*! @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( ) { f_Buffer_read(0); }
a3c4332001-06-20Per Hedbor 
61b7c82014-08-27Stephen R. van den Berg  /*! @decl void create(void|int(1..) initial_size)
e950862014-08-29Stephen R. van den Berg  *! @decl void create(string|Buffer|System.Memory value)
41730d2001-07-26Martin Nilsson  *! *! Initializes a new buffer. *!
1f88bf2001-09-24Henrik Grubbström (Grubba)  *! If no @[initial_size] is specified, 256 is used. If you
41730d2001-07-26Martin Nilsson  *! know approximately how big the buffer will be, you can optimize *! the operation of @[add()] (slightly) by passing the size to this *! function. */
e950862014-08-29Stephen R. van den Berg  PIKEFUN void create( string|object|int|void value )
a3c4332001-06-20Per Hedbor  { struct Buffer_struct *str = THIS;
e950862014-08-29Stephen R. van den Berg  struct pike_string *s; struct sysmem *sm; if( str->buffer ) Pike_error("Can not initialise twice.\n"); str->initial = 256; if (!args) goto definit; switch(TYPEOF(*value)) { default: Pike_error("Unsupported object type\n"); case PIKE_T_INT: str->initial = MAX(value->u.integer, 1 ); definit: init_string_builder_alloc(&str->str, str->initial, 0); str->buffer = str->str.s->str; break; case PIKE_T_STRING: s = value->u.string; if (s->refs == 1) /* Unlink the string and use it as buffer directly. */ unlink_pike_string (s); else add_ref(s); str->str.s = s; str->len = str->str.malloced = s->len; str->shift = str->str.known_shift = s->size_shift; str->buffer = s->str; break; case PIKE_T_OBJECT: if (value->u.object->prog == Buffer_program) { struct Buffer_struct *str2 = OBJ2_BUFFER(value->u.object); str->buffer = str2->buffer; str->offset = str2->offset; str->len = str2->len; str->shift = str2->shift; if (str->source = str2->source) add_ref(str->source); str->str = str2->str; if (str->str.s) add_ref(str->str.s); } else if (sm = system_memory(value->u.object)) { add_ref(str->source = value->u.object); str->buffer = sm->p; str->len = sm->size; } break; }
a3c4332001-06-20Per Hedbor  }
18c2252003-04-10Martin Nilsson  /*! @decl string _sprintf( int flag, mapping flags ) *! It is possible to @[sprintf] a String.Buffer object
4fae7f2014-08-27Stephen R. van den Berg  *! as @tt{%s@} just as if it were a string.
18c2252003-04-10Martin Nilsson  */
a3c4332001-06-20Per Hedbor  PIKEFUN string _sprintf( int flag, mapping flags ) {
e950862014-08-29Stephen R. van den Berg  pop_n_elems( args );
a3c4332001-06-20Per Hedbor  switch( flag ) { case 'O':
e950862014-08-29Stephen R. van den Berg  {
a3c4332001-06-20Per Hedbor  struct Buffer_struct *str = THIS;
e950862014-08-29Stephen R. van den Berg  push_text( "Buffer(%d-%d /* %d */)" ); push_int(str->len); push_int(str->offset);
bd23ae2014-08-27Stephen R. van den Berg  push_int(str->str.malloced);
e950862014-08-29Stephen R. van den Berg  f_sprintf( 4 ); break; }
a3c4332001-06-20Per Hedbor  case 's':
e950862014-08-29Stephen R. van den Berg  if( Pike_fp->current_object->refs != 1 || THIS->str.s->refs != 1) f_Buffer_get_copy( 0 ); else f_Buffer_read( 0 ); break;
a3c4332001-06-20Per Hedbor  case 't':
e950862014-08-29Stephen R. van den Berg  push_string(make_shared_binary_string("Buffer",6)); break; default: push_undefined();
a3c4332001-06-20Per Hedbor  }
e950862014-08-29Stephen R. van den Berg  } /*! @decl string _encode() *! @decl void _decode(string x) *! *! Encode and decode @[String.Buffer] objects. *! Only the buffer data is kept, no other state is saved. */ PIKEFUN string _encode() { f_Buffer_read( 0 ); } PIKEFUN void _decode(string x) { if( THIS->str.s->len ) Pike_error("Cannot initialise twice.\n"); f_Buffer_add( 1 );
a3c4332001-06-20Per Hedbor  }
7a74cc2014-08-26Per Hedbor  /*! @decl string|int cast( string type )
18c2252003-04-10Martin Nilsson  *! It is possible to cast a String.Buffer object to *! a @expr{string@} and an @expr{int@}. */
7a74cc2014-08-26Per Hedbor  PIKEFUN string|int cast( string type )
68ec3f2014-08-18Martin Nilsson  flags ID_PROTECTED;
a3c4332001-06-20Per Hedbor  {
68ec3f2014-08-18Martin Nilsson  if( type == literal_string_string )
a3c4332001-06-20Per Hedbor  {
68ec3f2014-08-18Martin Nilsson  pop_stack();
e950862014-08-29Stephen R. van den Berg  if( Pike_fp->current_object->refs != 1 || THIS->str.s->refs != 1)
a3c4332001-06-20Per Hedbor  f_Buffer_get_copy( 0 ); else
e950862014-08-29Stephen R. van den Berg  f_Buffer_read( 0 );
a3c4332001-06-20Per Hedbor  return; }
68ec3f2014-08-18Martin Nilsson  if( type == literal_int_string )
a3c4332001-06-20Per Hedbor  { struct Buffer_struct *str = THIS; pop_stack();
e950862014-08-29Stephen R. van den Berg  if( Pike_fp->current_object->refs != 1 || THIS->str.s->refs != 1)
a3c4332001-06-20Per Hedbor  f_Buffer_get_copy( 0 ); else
e950862014-08-29Stephen R. van den Berg  f_Buffer_read( 0 );
a3c4332001-06-20Per Hedbor  o_cast_to_int( ); return; }
68ec3f2014-08-18Martin Nilsson  pop_stack(); push_undefined();
a3c4332001-06-20Per Hedbor  }
e950862014-08-29Stephen R. van den Berg 
5f922f2014-08-27Stephen R. van den Berg  /*! @decl int `[](int index)
96881a2014-08-25Stephen R. van den Berg  */
5f922f2014-08-27Stephen R. van den Berg  PIKEFUN int `[](int index) {
e950862014-08-29Stephen R. van den Berg  struct Buffer_struct *str = THIS; unsigned len = str->len;
5f922f2014-08-27Stephen R. van den Berg  if (index<0) index += len; if (index<0 || index>=len) index_error("Buffer->`[]", Pike_sp, args, NULL, Pike_sp, "Index %"PRINTPIKEINT"d is out of array range 0..%d,\n", index, len-1);
e950862014-08-29Stephen R. van den Berg  RETURN generic_extract(str->buffer, str->shift, index);
5f922f2014-08-27Stephen R. van den Berg  } /*! @decl Buffer `[..](int start, int start_type, int end, int end_type) */ PIKEFUN Buffer `[..](int start, int start_type, int end, int end_type)
96881a2014-08-25Stephen R. van den Berg  { struct Buffer_struct *str = THIS;
e950862014-08-29Stephen R. van den Berg  size_t len = str->len; unsigned shift = str->shift; struct pike_string *s;
5f922f2014-08-27Stephen R. van den Berg  struct object *res; struct Buffer_struct *str2; pop_n_elems(args); if (start_type == INDEX_FROM_END) start = len-1-start; if (end_type != INDEX_FROM_BEG) end = len-1-end; res = fast_clone_object( Buffer_program ); str2 = OBJ2_BUFFER( res ); if (start < 0) start = 0; if (end >= len) end = len-1;
e950862014-08-29Stephen R. van den Berg  if (str->str.s) { add_ref(str->str.s); str2->str = str->str; } str2->offset = str->offset+start; str2->len = end-start+1; str2->buffer = str->buffer+(start<<shift); str2->shift = str->shift; str2->initial = str->initial;
5f922f2014-08-27Stephen R. van den Berg  if( (Pike_fp->current_object->flags & OBJECT_CLEAR_ON_EXIT) )
e950862014-08-29Stephen R. van den Berg  res->flags |= OBJECT_CLEAR_ON_EXIT; push_object(res);
96881a2014-08-25Stephen R. van den Berg  } /*! @decl int `[]=(int index, int ch) */ PIKEFUN int `[]=(int index, int ch) { struct Buffer_struct *str = THIS;
e950862014-08-29Stephen R. van den Berg  struct pike_string *s; size_t len = str->len;
96881a2014-08-25Stephen R. van den Berg  pop_n_elems(args); if (index<0) index += len; if (index<0 || index>=len) index_error("Buffer->`[]=", Pike_sp, args, NULL, Pike_sp, "Index %"PRINTPIKEINT"d is out of array range 0..%d,\n", index, len-1);
e950862014-08-29Stephen R. van den Berg  len = 0;
f4ded82014-08-27Stephen R. van den Berg  if ((unsigned)ch >= 256)
e950862014-08-29Stephen R. van den Berg  switch(str->shift) {
f4ded82014-08-27Stephen R. van den Berg  case 0: if ((unsigned)ch < 65536) len = 1; else { case 1: if((unsigned)ch >= 65536) len = 2; else break; }
e950862014-08-29Stephen R. van den Berg  str->str.known_shift = len;
f4ded82014-08-27Stephen R. van den Berg  }
e950862014-08-29Stephen R. van den Berg  s = buffer_mkspace(0, len); low_set_index(s, index+str->offset, ch);
96881a2014-08-25Stephen R. van den Berg  push_int(ch); }
e950862014-08-29Stephen R. van den Berg  /*! @decl Buffer `+=( string|Buffer ... what )
18c2252003-04-10Martin Nilsson  */
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer `+=( string|Buffer ... what )
d6e06b2013-08-30Henrik Grubbström (Grubba)  rawtype tFunc(tOr(tString, tObjIs_BUFFER), tObjIs_BUFFER);
a3c4332001-06-20Per Hedbor  {
e950862014-08-29Stephen R. van den Berg  f_Buffer_add( args ); pop_stack(); ref_push_object(Pike_fp->current_object);
a3c4332001-06-20Per Hedbor  }
173e872003-04-07Martin Stjernholm 
e950862014-08-29Stephen R. van den Berg  /*! @decl Buffer `+( string|Buffer ... what )
18c2252003-04-10Martin Nilsson  */
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer `+( string|Buffer ... what )
d6e06b2013-08-30Henrik Grubbström (Grubba)  rawtype tFunc(tOr(tString, tObjIs_BUFFER), tObjIs_BUFFER);
173e872003-04-07Martin Stjernholm  {
e950862014-08-29Stephen R. van den Berg  struct Buffer_struct *str = THIS, *str2; struct pike_string *s = str->str.s; if( Pike_fp->current_object->refs != 1 || s->refs != 1) { struct Buffer_struct *str2; unsigned shift = str->shift; size_t len = str->len; struct object *res = fast_clone_object( Buffer_program ); str2 = OBJ2_BUFFER( res ); str2->initial = str->initial; str2->shift = shift; init_string_builder_alloc (&str2->str, MAX(len, str2->initial), shift); str2->str.s->len = str2->len = len; memcpy(str2->buffer = str2->str.s->str, str->buffer, len<<shift); if( (Pike_fp->current_object->flags & OBJECT_CLEAR_ON_EXIT) ) res->flags |= OBJECT_CLEAR_ON_EXIT; apply( res, "add", args ); pop_stack(); ref_push_object(res); } else f_Buffer_cq__backtick_add_eq(args);
173e872003-04-07Martin Stjernholm  }
a3c4332001-06-20Per Hedbor 
e950862014-08-29Stephen R. van den Berg  /*! @decl Buffer ``+( string ... what ) */ PIKEFUN Buffer ``+( string ... what ) rawtype tFunc(tString, tObjIs_BUFFER);
0ecca42014-08-27Stephen R. van den Berg  {
e950862014-08-29Stephen R. van den Berg  struct Buffer_struct *str = THIS, *str2; if( Pike_fp->current_object->refs != 1 || str->str.s->refs != 1) { struct Buffer_struct *str2; struct object *res = fast_clone_object( Buffer_program ); str2 = OBJ2_BUFFER( res ); str2->initial = str->initial; if( (Pike_fp->current_object->flags & OBJECT_CLEAR_ON_EXIT) ) res->flags |= OBJECT_CLEAR_ON_EXIT; ref_push_object(Pike_fp->current_object); apply( res, "add", args+1 ); } else { char*dest; struct svalue*pargs = Pike_sp-args; int j,shift = 0; size_t sum = 0, len; pargs = Pike_sp; j = args; do { struct pike_string *a = --pargs->u.string; sum += a->len; shift |= a->size_shift; } while(--j); shift |= str->shift; shift = shift & ~(shift >> 1); buffer_mkspace(sum - str->str.s->len + (len = str->len), shift); memmove(str->str.s->str+(sum<<shift), str->buffer, len<<shift); str->buffer = dest = str->str.s->str; str->offset = 0; str->str.s->len = str->len = len + sum; do { struct pike_string *bs = pargs++->u.string; size_t blen = bs->len; generic_memcpy(MKPCHARP(dest, shift), MKPCHARP_STR( bs ), blen); dest += blen<<shift; } while(--args); ref_push_object(Pike_fp->current_object); } } static int buffer_cmp(struct svalue*other, unsigned stricttype) { struct Buffer_struct *str = THIS; struct pike_string *s2; PCHARP b; ptrdiff_t blen; switch(TYPEOF(*other)) {
0ecca42014-08-27Stephen R. van den Berg  case PIKE_T_STRING:
e950862014-08-29Stephen R. van den Berg  b = MKPCHARP_STR(s2 = other->u.string); blen = s2->len; goto runcmp;
0ecca42014-08-27Stephen R. van den Berg  case PIKE_T_OBJECT:
e950862014-08-29Stephen R. van den Berg  if (other->u.object->prog == Buffer_program) { struct Buffer_struct *str2 = OBJ2_BUFFER(other->u.object); b = MKPCHARP(str2->buffer, str2->shift); blen = str2->len; runcmp: return my_quick_pcharpcmp( MKPCHARP(str->buffer, str->shift), str->len, b, blen); }
0ecca42014-08-27Stephen R. van den Berg  } if(stricttype) Pike_error("Unsupported types in comparison.\n");
e950862014-08-29Stephen R. van den Berg  return 1;
0ecca42014-08-27Stephen R. van den Berg  }
4fae7f2014-08-27Stephen R. van den Berg  /*! @decl int(0..1) `==( mixed other )
9da77e2014-08-27Stephen R. van den Berg  *! *! Is able to compare directly with strings and other Buffers.
bdc3d42014-08-27Stephen R. van den Berg  */ PIKEFUN int(0..1) `==( mixed other ) rawtype tFunc(tMixed, tInt01); {
e950862014-08-29Stephen R. van den Berg  RETURN !buffer_cmp(other, 0);
0ecca42014-08-27Stephen R. van den Berg  }
bdc3d42014-08-27Stephen R. van den Berg 
4fae7f2014-08-27Stephen R. van den Berg  /*! @decl int(0..1) `<( mixed other )
0ecca42014-08-27Stephen R. van den Berg  *! *! Is able to compare directly with strings and other Buffers. */ PIKEFUN int(0..1) `<( mixed other ) rawtype tFunc(tMixed, tInt01); {
e950862014-08-29Stephen R. van den Berg  RETURN buffer_cmp(other, 1)<0;
0ecca42014-08-27Stephen R. van den Berg  }
4fae7f2014-08-27Stephen R. van den Berg  /*! @decl int(0..1) `>( mixed other )
0ecca42014-08-27Stephen R. van den Berg  *! *! Is able to compare directly with strings and other Buffers. */ PIKEFUN int(0..1) `>( mixed other ) rawtype tFunc(tMixed, tInt01); {
e950862014-08-29Stephen R. van den Berg  RETURN buffer_cmp(other, 1)>0; } static void buffer_putchar(int ch, unsigned mag) { struct Buffer_struct *str = THIS; void*dest; unsigned shift; pop_stack(); buffer_mkspace(1, mag); shift = str->shift; dest = str->buffer+(str->len++<<shift); switch( shift ) { case 0: *(p_wchar0*)dest = ch; break; case 1: *(p_wchar1*)dest = ch; break; default: *(p_wchar2*)dest = ch; break; } str->str.s->len = str->offset+str->len; ref_push_object(Pike_fp->current_object);
bdc3d42014-08-27Stephen R. van den Berg  }
e950862014-08-29Stephen R. van den Berg  /*! @decl Buffer putchar( int char ) *! @decl Buffer add_byte( int(0..255) i ) *! @decl Buffer add_int8( int(-128..127) i )
9974292011-01-17Henrik Grubbström (Grubba)  *!
e950862014-08-29Stephen R. van den Berg  *! Appends a single character at the end of the string.
9974292011-01-17Henrik Grubbström (Grubba)  *! *! @returns
e950862014-08-29Stephen R. van den Berg  *! Returns the buffer itself.
d6e06b2013-08-30Henrik Grubbström (Grubba)  *!
9974292011-01-17Henrik Grubbström (Grubba)  *! @seealso *! @[add()] */
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer putchar(int ch) { buffer_putchar(ch, min_magnitude(ch)); } PIKEFUN int add_byte( int(0..255) i ) { buffer_putchar(i&255, 0); } PIKEFUN int add_int8( int(-128..127) i ) { buffer_putchar(i&255, 0); } /*! @decl Buffer add_int( int i, int(0..) width ) *! *! Appends a generic integer to the buffer as an (width*8)bit *! network byteorder number. *! *! @returns *! Returns the buffer itself. *! *! @seealso *! @[add_int32()] */ PIKEFUN Buffer add_int( int i, int width ) {
9974292011-01-17Henrik Grubbström (Grubba)  struct Buffer_struct *str = THIS;
a505a92014-08-26Stephen R. van den Berg  struct pike_string *s;
e950862014-08-29Stephen R. van den Berg  ptrdiff_t len;
9974292011-01-17Henrik Grubbström (Grubba) 
e950862014-08-29Stephen R. van den Berg  s = buffer_mkspace(width, 0); len = str->offset+str->len; if(width>=0) for(str->len += width, s->len = len+=width; width--; i>>=8) low_set_index(s, --len, i&0xff); else for(str->len -= width, s->len = len-width; width++; i>>=8) low_set_index(s, len++, i&0xff);
9974292011-01-17Henrik Grubbström (Grubba) 
e950862014-08-29Stephen R. van den Berg  pop_n_elems(args); ref_push_object(Pike_fp->current_object); }
9974292011-01-17Henrik Grubbström (Grubba) 
e950862014-08-29Stephen R. van den Berg  static void buffer_add_bignum( struct object *i, int width ) { struct Buffer_struct *str = THIS; struct pike_string *snum;
a505a92014-08-26Stephen R. van den Berg 
e950862014-08-29Stephen R. van den Berg  push_int(256); apply( i, "digits", 1 );
a505a92014-08-26Stephen R. van den Berg 
e950862014-08-29Stephen R. van den Berg  snum = Pike_sp[-1].u.string;
9974292011-01-17Henrik Grubbström (Grubba) 
e950862014-08-29Stephen R. van den Berg  /* FIXME: little endian */ if( snum->len > width ) Pike_error("Number too large to store in %d bits\n", width*8); push_int (str->len + width-snum->len); stack_swap(); f_Buffer_appendat( 2 ); } PIKEFUN Buffer add_int( object i, int width ) { pop_stack(); /* width */ convert_stack_top_to_bignum(); buffer_add_bignum ( Pike_sp[-1].u.object, width); stack_pop_keep_top(); /* i */ } static void buffer_do_rewind_on_error( void*arg ) { struct Buffer_struct *str = THIS; str->str.s->len = str->offset+(str->len = arg-(void*)str->buffer); } static void buffer_begin_rewind_on_error( ONERROR *x ) { struct Buffer_struct *str = THIS; SET_ONERROR( (*x), buffer_do_rewind_on_error, str->buffer+str->len ); }
9974292011-01-17Henrik Grubbström (Grubba) 
e950862014-08-29Stephen R. van den Berg  static void buffer_end_rewind_on_error( ONERROR *x ) { UNSET_ONERROR( (*x) );
9974292011-01-17Henrik Grubbström (Grubba)  }
e950862014-08-29Stephen R. van den Berg  /*! @decl Buffer add_ints( array(int) integers, int(0..255) len )
96fb382014-08-25Stephen R. van den Berg  *!
e950862014-08-29Stephen R. van den Berg  *! Add the integers in the specified array, @[len] bytes per int. *! Equivalent to add_int( integers[*], len ) but faster. */ PIKEFUN Buffer add_ints( array(int) a, int bpi ) { struct Buffer_struct *str = THIS; size_t i,l = a->size; struct svalue *it = a->item; if( bpi < 0 ) Pike_error("Invalid int width\n"); /* FIXME: little endian? */ if (bpi <= SIZEOF_INT_TYPE) { struct pike_string *s = buffer_mkspace(bpi*l, 0); size_t len = str->offset+str->len - bpi; for (i=l; i--; it++) { INT_TYPE si; unsigned j; if( TYPEOF(*it) == PIKE_T_INT ) si = it->u.integer; else if( is_bignum_object_in_svalue( it ) ) { INT64 i64; if( int64_from_bignum( &i64, it->u.object ) ) si = i64; else Pike_error("Too big bignum\n"); /* FIXME: support these anyway? */ } else Pike_error("Non integer in array\n"); for(len+=(j=bpi)<<1; j--; si>>=8) low_set_index(s, --len, si&0xff); } str->len = (s->len = len + bpi) - str->offset; } else { /* bignums. */ ONERROR e; buffer_begin_rewind_on_error( &e ); for (i=l; i--;) { push_svalue( it++ ); push_int( bpi ); f_Buffer_add_int(2); pop_stack(); } buffer_end_rewind_on_error( &e ); } pop_n_elems(args); ref_push_object(Pike_fp->current_object); } /*! @decl Buffer add_int16( int(-32768..32767) i ) *! @decl Buffer add_short( int(0..65535) i ) *! *! Appends an int16 at the end of the string.
96fb382014-08-25Stephen R. van den Berg  *! *! @returns
e950862014-08-29Stephen R. van den Berg  *! Returns the buffer itself.
96fb382014-08-25Stephen R. van den Berg  *! *! @seealso
e950862014-08-29Stephen R. van den Berg  *! @[add()],@[add_byte()],@[add_int8()]
96fb382014-08-25Stephen R. van den Berg  */
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer add_int16( int(-32768..32767) i ) { push_int(2); f_Buffer_add_int(2);
96fb382014-08-25Stephen R. van den Berg  }
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer add_short( int(0..65535) i ) { f_Buffer_add_int16(1);
6ce0142003-12-08Martin Nilsson  }
e950862014-08-29Stephen R. van den Berg  /*! @decl Buffer add_int32( int(-2147483648..2147483647) i ) *! @decl Buffer add_long( int(0..4294967295) i ) *! *! Appends an int32 at the end of the string. *! *! @returns *! Returns the buffer itself. *! *! @seealso *! @[add()],@[add_byte()],@[add_int8()]
1e7c742013-05-06Martin Nilsson  */
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer add_int32( int(-2147483648..2147483647) i ) { push_int(4); f_Buffer_add_int(2); }
73c7ca2013-05-07Martin Nilsson 
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer add_long( int(0..4294967295) i ) { f_Buffer_add_int32(1);
1e7c742013-05-06Martin Nilsson  }
e950862014-08-29Stephen R. van den Berg  /*! @decl Buffer add_hstring( string|Buffer|System.Memory data, int size_size )
41730d2001-07-26Martin Nilsson  *!
e950862014-08-29Stephen R. van den Berg  *! Adds length/data for @[data] to the buffer. *! *! This is identical to @[sprintf("%"+size_size+"H",data)] but *! significantly faster. *! *! @[size_size] must be less than Int.NATIVE_MAX. *! *! @returns *! Returns the buffer itself.
d6e06b2013-08-30Henrik Grubbström (Grubba)  *! *! @seealso
e950862014-08-29Stephen R. van den Berg  *! @[add()],@[sprintf()]
41730d2001-07-26Martin Nilsson  */
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer add_hstring( string|Buffer|object str, int size_size ) { size_t len; switch(TYPEOF(*str)) { case PIKE_T_STRING: len = str->u.string->len; break; case PIKE_T_OBJECT:
73b07a2001-06-21Per Hedbor  {
e950862014-08-29Stephen R. van den Berg  struct sysmem *sm; if (str->u.object->prog == Buffer_program) { len = OBJ2_BUFFER(str->u.object)->len;
5929f32014-08-25Stephen R. van den Berg  break;
e950862014-08-29Stephen R. van den Berg  } if (sm = system_memory(str->u.object)) { len = sm->size;
5929f32014-08-25Stephen R. van den Berg  break;
e950862014-08-29Stephen R. van den Berg  }
73b07a2001-06-21Per Hedbor  }
e950862014-08-29Stephen R. van den Berg  default: Pike_error("Bad argument 1 to add_hstring()," " expected string|Buffer|System.Memory.\n");
a3c4332001-06-20Per Hedbor  }
e950862014-08-29Stephen R. van den Berg  /* We know this is safe for size_size>=4, since pike strings are at * most 0x7ffffff bytes long. */ if( size_size < 4 && len > (1<<(8*(size_size<0?-size_size:size_size)))-1 ) Pike_error("String too long\n"); pop_stack(); push_int(len); push_int(size_size); f_Buffer_add_int( 2 ); pop_stack(); f_Buffer_append( 1 );
a3c4332001-06-20Per Hedbor  }
e950862014-08-29Stephen R. van den Berg  /*! @decl int sprintf(strict_sprintf_format format, sprintf_args ... args) *! Appends the output from @[sprintf] at the end of the string. *! Returns the buffer itself.
41730d2001-07-26Martin Nilsson  */
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer sprintf(mixed ... arguments) rawtype tFuncV(tAttr("strict_sprintf_format", tOr(tStr, tObj)), tAttr("sprintf_args", tMix), tStr);
a3c4332001-06-20Per Hedbor  { struct Buffer_struct *str = THIS;
e950862014-08-29Stephen R. van den Berg  struct pike_string *s; size_t oldlen; ONERROR e; buffer_mkspace(0, 0); oldlen = str->str.s->len; buffer_begin_rewind_on_error( &e ); low_f_sprintf(args, 0, &str->str); buffer_end_rewind_on_error( &e ); pop_n_elems(args); s = str->str.s; str->buffer = s->str + (str->offset<<(str->shift = s->size_shift)); str->len += s->len-oldlen; ref_push_object(Pike_fp->current_object);
a3c4332001-06-20Per Hedbor  }
e950862014-08-29Stephen R. van den Berg  /*! @decl Buffer|void cut(int start, int|void end, void|int(0..1) discard)
96881a2014-08-25Stephen R. van den Berg  *! *! Cut and delete the range of data from the current buffer. *! Returns a new buffer with the cut data, unless discard is true. *! *! @seealso *! @[get()], @[get_copy()], @[clear()] */
e950862014-08-29Stephen R. van den Berg  PIKEFUN Buffer|void cut(int index, int|void end_or_none, void|int(0..1) discard)
96881a2014-08-25Stephen R. van den Berg  { struct Buffer_struct *str = THIS, *str2; struct object *res;
e950862014-08-29Stephen R. van den Berg  unsigned shift; size_t len; INT_TYPE end, vdiscard;
96881a2014-08-25Stephen R. van den Berg 
e950862014-08-29Stephen R. van den Berg  len = str->len; shift = str->str.s->size_shift;
96881a2014-08-25Stephen R. van den Berg  end = args==1 ? len-1 : end_or_none->u.integer; vdiscard = args==3 ? discard->u.integer : 0; pop_n_elems(args); if (index < 0) index = 0;
e950862014-08-29Stephen R. van den Berg  if (++end > len) end = len;
d505c72014-08-27Stephen R. van den Berg 
e950862014-08-29Stephen R. van den Berg  str->len -= len = end-index; if (index) index += str->offset, end+=str->offset; if (!vdiscard) {
96881a2014-08-25Stephen R. van den Berg  res = fast_clone_object( Buffer_program ); str2 = OBJ2_BUFFER( res );
e950862014-08-29Stephen R. van den Berg  str2->shift = str->shift; str2->len = len; if (index) { init_string_builder_alloc(&str2->str, str2->initial = len, 0); string_builder_append(&str2->str, MKPCHARP_OFF(str->buffer, str->shift, index), len); str2->buffer = str2->str.s->str; } else { str2->offset = str->offset; str2->initial = str->initial; str2->buffer = str->buffer; if (str->str.s) { add_ref(str->str.s); str2->str = str->str; } }
96881a2014-08-25Stephen R. van den Berg  }
e950862014-08-29Stephen R. van den Berg  if(index) { struct pike_string *s = buffer_mkspace(0, 0); memmove(s->str+(index<<shift), s->str+(end<<shift), (s->len-end)<<shift); s->len -= len; } else str->offset += end, str->buffer += end<<shift;
96881a2014-08-25Stephen R. van den Berg 
e950862014-08-29Stephen R. van den Berg  if(!vdiscard) {
96881a2014-08-25Stephen R. van den Berg  if( (Pike_fp->current_object->flags & OBJECT_CLEAR_ON_EXIT) )
bd23ae2014-08-27Stephen R. van den Berg  res->flags |= OBJECT_CLEAR_ON_EXIT;
96881a2014-08-25Stephen R. van den Berg  push_object(res); } else push_undefined(); }
e950862014-08-29Stephen R. van den Berg  /*! @decl Buffer read_buffer(int n) *! *! Same as @[read()], but returns the result as a @[Buffer]. *! *! @seealso *! @[read()], @[get()], @[trim()] */ PIKEFUN Buffer|void read_buffer(int n) { struct Buffer_struct *str = THIS, *str2; struct pike_string *s = str->str.s; size_t len = str->len; struct object *res; while (n<0 || n>len) if (!buffer_range_error( n )) { pop_n_elems(args); push_undefined(); return; } pop_n_elems(args); res = fast_clone_object( Buffer_program ); str2 = OBJ2_BUFFER( res ); if (s) add_ref(s); str2->str = str->str; str2->buffer = str->buffer; str2->offset = str->offset; str2->shift = str->shift; str2->len = n; if( (Pike_fp->current_object->flags & OBJECT_CLEAR_ON_EXIT) ) res->flags |= OBJECT_CLEAR_ON_EXIT; push_object(res); } #define LONGEST_HIGH_BYTE (~(MAX_ULONGEST>>8)) static LONGEST buffer_read_number(size_t n) { struct Buffer_struct *str = THIS; unsigned shift = str->shift; unsigned char*buf = str->buffer; LONGEST res = 0; if (n>=0) while (n--) { if (LONGEST_HIGH_BYTE&res) goto overflow; res<<=8; res|=*buf; buf+=1<<shift; } else for (buf+=n<<shift; n++; ) { if (LONGEST_HIGH_BYTE&res) goto overflow; res<<=8; buf-=1<<shift; res|=*buf; } if (res<0) overflow: Pike_error("Integer (%dbit) overflow.\n", SIZEOF_LONGEST*8); return res; } static int buffer_rc_number(size_t n) { struct Buffer_struct *str = THIS; pop_stack(); for(;;) { LONGEST slen; ptrdiff_t len = str->len; if ((len -= n)<0) goto rangeerror; slen = buffer_read_number(n); if ((len -= slen)<0) { rangeerror: if( buffer_range_error( -len ) ) continue; push_undefined(); return 0; } str->len -= n; str->offset += n; str->buffer += n<<str->shift; push_int(slen); return 1; } } static int buffer_presscanf(const struct pike_string*format) { struct Buffer_struct *str = THIS; ptrdiff_t num_used; goto jin; do { if (!buffer_range_error(0)) return 0; jin: low_sscanf_pcharp( MKPCHARP(str->buffer, str->shift), str->len, MKPCHARP_STR(format), format->len, &num_used, 0); } while (!num_used); str->len -= num_used; str->offset += num_used; str->buffer += num_used<<str->shift; return 1; } /*! @decl int read_int( int n ) *! *! Read a network (if n is positive) or little endian (if n is *! negative) byte order unsigned number of size n*8 bits, then *! return it. *! *! @returns *! Will return -1 if there is not enough buffer space available *! unless error mode is set to throw errors. */ PIKEFUN int(0..)|int(-1..-1) read_int( int n ) { struct Buffer_struct *str = THIS; while (str->len < n) if (!buffer_range_error( (int)str->len-n )) { Pike_sp[-1].u.integer = -1; return; } if( n < SIZEOF_INT_TYPE ) { /* will for sure fit. */ pop_stack(); push_int(buffer_read_number(n)); str->len -= n; str->offset += n; } else { f_Buffer_read( 1 ); push_int(256); push_object(clone_object( get_auto_bignum_program(), 2 )); reduce_stack_top_bignum(); } } /*! @decl string read_hstring( int(0..) n ) *! *! Identical in functionality to @[read](@[read_int](@[n])) but *! faster. *! *! Read a network byte order number of size n*8 bits, then return the *! indicated number of bytes as a string. *! @returns *! If there is not enough data available return 0. *! *! Note that a pike string can not be longer than 0x7fffffff bytes (~2Gb). */ PIKEFUN string|void read_hstring( int n ) { if(buffer_rc_number(n)) f_Buffer_read( 1 ); } /*! @decl Buffer read_hbuffer( int n ) *! *! Same as @[read_hstring], but returns the result as a Buffer. *! */ PIKEFUN Buffer|void read_hbuffer( int n ) { if(buffer_rc_number(n)) f_Buffer_read_buffer( 1 ); } /*! @decl array|void sscanf(string format) *! *! Reads data from the beginning of the buffer to match the *! specifed format, then return an array with the matches. *! *! The non-matching data will be left in the buffer. *! *! See @[array_sscanf] for more information. */ PIKEFUN array|void sscanf( string format ) { struct svalue *start = Pike_sp; unsigned matched, results; matched = buffer_presscanf(format); results = Pike_sp - start; if(matched) f_aggregate(results); else { pop_n_elems(results); push_undefined(); } } /*! @decl mixed|void match(string format) *! *! Reads data from the beginning of the buffer to match the *! specifed format, then return the match. *! *! The non-matching data will be left in the buffer. *! *! This function is very similar to @[sscanf], but the *! result is the sum of the matches. Most useful to match *! a single value. *! *! @example *! @code *! // get the next whitespace separated word from the buffer. *! buffer->match("%*[ \t\r\n]%*[^ \t\r\n]"); *! @endcode */ PIKEFUN string|int|float|array|void match( string format ) { struct svalue *start = Pike_sp; unsigned matched, results; matched = buffer_presscanf(format); results = Pike_sp - start; if(matched) f_add(results); else { pop_n_elems(results); push_undefined(); } } /*! @decl int(0..)|int(-1..-1) consume(int(0..) n) *! *! Discard the next @[n] bytes from the beginning of the buffer. *! *! @returns *! Returns the remaining size of the buffer, or -1 if you attempted *! to consume more than was available. *! *! @seealso *! @[cut()], @[unread()] */ PIKEFUN int(-1..) consume( int(0..) n ) { struct Buffer_struct *str = THIS; int left; while (n<0 || (left = str->len-n) < 0) if (!buffer_range_error( -left )) { left = -1; goto ret; } str->len -= n; str->offset += n; str->buffer += n<<str->shift; ret: Pike_sp[-1].u.integer = left; } /*! @decl int(0..)|int(-1..-1) unread(int(0..)|string|Buffer n) *! *! Rewind the buffer @[n] bytes. If passed a string of Buffer *! argument, it will push back that string at the front of the buffer. *! *! @returns *! Returns how many characters of buffer is available to rewind, *! or -1 if you attempted to rewind more than is available. *! *! @seealso *! @[consume()] */ PIKEFUN int(-1..) unread( int(0..)|string|Buffer n ) { struct Buffer_struct *str = THIS; int ret = Pike_sp[-1].u.integer; struct pike_string *s2; PCHARP b; ptrdiff_t blen; switch (TYPEOF(Pike_sp[-1])) { case PIKE_T_INT: ret = Pike_sp[-1].u.integer; while (ret<0 || ret>str->offset) if (!buffer_range_error( ret-str->offset )) { ret = -1; goto rangx1; } str->buffer -= ret<<str->shift; str->len += ret; ret = str->offset -= ret; rangx1: break; case PIKE_T_STRING: s2 = Pike_sp[-1].u.string; b = MKPCHARP_STR(s2); blen = s2->len; goto pastein; case PIKE_T_OBJECT: if (Pike_sp[-1].u.object->prog == Buffer_program) { struct Buffer_struct *str2 = OBJ2_BUFFER(Pike_sp[-1].u.object); ptrdiff_t dif; b = MKPCHARP(str2->buffer, str2->shift); blen = str2->len; pastein: if ((dif = (ptrdiff_t)str->offset-blen) < 0) { struct pike_string *s = buffer_mkspace(-dif, b.shift); unsigned shift = s->size_shift; memmove(s->str+(blen<<shift), str->buffer, str->len<<shift); str->buffer = s->str; s->len = str->len += blen; ret = str->offset = 0; } else { buffer_mkspace(0, 0); str->buffer -= blen<<str->shift; str->len += blen; ret = str->offset = dif; } generic_memcpy(MKPCHARP(str->buffer, str->shift), b, blen); break; } default: SIMPLE_BAD_ARG_ERROR("unread", 1, "int(0..)|string|String.Buffer"); } pop_stack(); push_int(ret); } static int buffer_is_whitespace(struct Buffer_struct *str, size_t pos) { switch( generic_extract(str->buffer, str->shift, pos) ) { SPACECASE8 return 1; } return 0; } /*! @decl mixed read_json(int|void require_whitespace_separator) *! *! Read a single JSON expression from the buffer and return it. *! *! If @[require_whitespace_separator] is true there must be a whitespace *! after each json value (as an example, newline or space). *! *! The JSON is assumed to be utf-8 encoded. *! *! @returns *! UNDEFINED if no data is available to read. *! The read value otherwise. *! *! @note *! Unless strwhitespaces are required this function only really work correctly *! with objects, arrays and strings. *! *! There is really no way to see where one value starts and the other ends *! for most other cases */ PIKEFUN mixed read_json(int|void require_whitespace) { struct Buffer_struct *str = THIS; unsigned whites = 0; static ptrdiff_t(*parse_json_pcharp)(PCHARP,size_t,int,char**); if( require_whitespace ) { whites = require_whitespace->u.integer; pop_stack(); } if( !parse_json_pcharp ) parse_json_pcharp = PIKE_MODULE_IMPORT(Standards.JSON, parse_json_pcharp ); for(;;) { char *err = NULL; ptrdiff_t stop = parse_json_pcharp( MKPCHARP(str->buffer,str->shift), str->len, 1|8, &err ); /* json_utf8 */ if( stop < 0 ) if( -stop == str->len || (err && !strncmp(err,"Unterminated",12))) { if (buffer_range_error( 0 )) continue; push_undefined(); } else /* FIXME: Use real json error? */ if( err ) Pike_error("Syntax error in json at offset %d: %s\n", -stop, err ); else Pike_error("Syntax error in json at offset %d\n", -stop ); else if( whites && (stop == str->len || !buffer_is_whitespace(str,stop)) && !buffer_is_whitespace(str,stop-1)) if( stop == str->len ) { if (buffer_range_error( 0 )) continue; pop_stack(); push_undefined(); } else Pike_error("Missing whitespace between json values at offset %d\n", stop ); else { if( whites ) while( buffer_is_whitespace( str, stop ) ) stop++; push_int( stop ); f_Buffer_consume( 1 ); pop_stack(); } break; } } /*! @decl void trim() *! *! Compact buffer, free unused memory. *! When called on a subbuffer, it clears the subbuffer and releases *! the parent buffer to be modified again. *! *! @note *! Calling this function excessively might slow things down, *! since the data often has to be copied. *! *! @seealso *! @[clear()]] */ PIKEFUN void trim() { struct Buffer_struct *str = THIS; struct pike_string *s = str->str.s; unsigned offset = str->offset, shift = s->size_shift; if (str->readonly || !s || s->refs!=1) buffer_mkspace(0, 0); else { if (str->offset) memmove(s->str, str->buffer, str->len<<str->shift); if (s = realloc_unlinked_string(s, str->len)) str->str.s = s, str->str.malloced = str->len; str->buffer = s->str; str->offset = 0; } }
d6e06b2013-08-30Henrik Grubbström (Grubba)  /*! @decl void clear() *!
4fae7f2014-08-27Stephen R. van den Berg  *! Empty the buffer, and discard the old content.
d6e06b2013-08-30Henrik Grubbström (Grubba)  *! *! @seealso
e950862014-08-29Stephen R. van den Berg  *! @[get()], @[cut()], @[trim()]
d6e06b2013-08-30Henrik Grubbström (Grubba)  */ PIKEFUN void clear() { struct Buffer_struct *str = THIS;
e950862014-08-29Stephen R. van den Berg  str->len = str->offset = 0;
bd23ae2014-08-27Stephen R. van den Berg  reset_string_builder(&str->str);
d6e06b2013-08-30Henrik Grubbström (Grubba)  }
edb0842001-07-11Martin Stjernholm  /*! @decl int _sizeof() *! *! Returns the size of the buffer. */
41730d2001-07-26Martin Nilsson  PIKEFUN int _sizeof()
edb0842001-07-11Martin Stjernholm  {
e950862014-08-29Stephen R. van den Berg  RETURN THIS->len;
edb0842001-07-11Martin Stjernholm  }
a3c4332001-06-20Per Hedbor  INIT { struct Buffer_struct *str = THIS;
21b12a2014-09-03Martin Nilsson  memset( str, 0, sizeof( *str ) );
a3c4332001-06-20Per Hedbor  } EXIT
8dcb7d2008-05-29Martin Stjernholm  gc_trivial;
a3c4332001-06-20Per Hedbor  { struct Buffer_struct *str = THIS;
e950862014-08-29Stephen R. van den Berg  struct pike_string *s; if (s = str->str.s) { if( Pike_fp->flags & OBJECT_CLEAR_ON_EXIT ) guaranteed_memset( s->str, 0, str->str.malloced ); free_string( s ); } if( str->source ) free_object( str->source );
a3c4332001-06-20Per Hedbor  }
45e13d2008-06-23Martin Stjernholm  GC_RECURSE {
bd23ae2014-08-27Stephen R. van den Berg  if (mc_count_bytes (Pike_fp->current_object))
45e13d2008-06-23Martin Stjernholm  mc_counted_bytes += THIS->str.malloced; }
e950862014-08-29Stephen R. van den Berg  #define BUFFER_BLOCK_SIZE 4096 /*! @decl int input_from( Stdio.Stream f, void|int n ) *! *! Read data from @[f] into this buffer. */ PIKEFUN int(0..) input_from( object f, void|int _n ) { struct Buffer_struct *str = THIS; size_t bread = 0, n = (size_t)-1; struct my_file *fd; if( _n ) n = _n->u.integer; buffer_mkspace(0, 0); if( (fd = get_storage( f, file_program )) ) { struct pike_string *s; void *tbuf = 0; if (str->shift) { tbuf = malloc(MIN(n,BUFFER_BLOCK_SIZE)); if (!tbuf) Pike_error("Out of memory allocating %d buffer space.\n", BUFFER_BLOCK_SIZE); } do { int res; void *ptr; size_t getnow = n-bread; if (getnow < BUFFER_BLOCK_SIZE) getnow = BUFFER_BLOCK_SIZE; s = buffer_mkspace(getnow, 0); ptr = tbuf? tbuf: s->str+s->len; /* shift is 0 when no tbuf */ buffer_lock(); { THREADS_ALLOW(); res = fd_read( fd->box.fd, ptr, getnow ); THREADS_DISALLOW(); } buffer_release(); if( res == -1 && errno == EINTR ) continue; if( res <= 0 ) break; if (tbuf) generic_memcpy(MKPCHARP_STR_OFF(s, s->len), MKPCHARP(tbuf,0), res); s->len += res; bread += res; if( res != getnow ) break; } while (n>bread); if (tbuf) free(tbuf); str->buffer = s->str + (str->offset<<str->shift); str->len += bread; } else /* some other object. Just call read */ for(;;) { push_int( BUFFER_BLOCK_SIZE ); safe_apply( f, "read", 1 ); if( TYPEOF(Pike_sp[-1]) != PIKE_T_STRING || Pike_sp[-1].u.string->len == 0 ) break; bread += Pike_sp[-1].u.string->len; f_Buffer_add( 1 ); pop_stack(); } RETURN bread; } /*! @decl int output_to( Stdio.Stream f, void|int n ) *! *! Write data from the buffer to the indicated file. *! *! Will return the number of bytes that were successfully written. */ PIKEFUN int(0..) output_to( object f, void|int _n ) { struct Buffer_struct *str = THIS; size_t sz = str->len; size_t written = 0; struct my_file *fd; INT_TYPE *wr = &Pike_sp->u.integer; if( _n ) sz = MIN(_n->u.integer, sz); if( !str->shift && (fd = get_storage( f, file_program )) ) { buffer_lock(); THREADS_ALLOW(); while( sz > written ) { int res = fd_write( fd->box.fd, str->buffer, sz-written ); if( res == -1 && errno == EINTR ) continue; if( res <= 0 ) break; str->buffer += res; written += res; } THREADS_DISALLOW(); str->len -= written; str->offset += written; buffer_release(); } else { /* some other object. Just call write */ while( sz > written ) { size_t rd = MIN(sz-written,BUFFER_BLOCK_SIZE); push_int(rd); f_Buffer_read( 1 ); if( TYPEOF(Pike_sp[-1]) != PIKE_T_STRING || Pike_sp[-1].u.string->len == 0 ) break; /* when this throws we need to rewind the buffer correctly. */ safe_apply(f, "write", 1); if( *wr <= 0 ) goto rewind; written += *wr; if( 0 < (rd-=*wr) ) { rewind: str->buffer -= rd<<str->shift; str->offset -= rd; str->len += rd; break; } pop_stack(); } } RETURN written; }
a3c4332001-06-20Per Hedbor }
41730d2001-07-26Martin Nilsson /*! @endclass
fed7de2001-06-28Henrik Grubbström (Grubba)  */ /*! @class Replace
c5e2a42004-04-30Martin Nilsson  *! *! 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.
fed7de2001-06-28Henrik Grubbström (Grubba)  */ PIKECLASS multi_string_replace {
6f6d2b2006-03-11Henrik Grubbström (Grubba)  CVAR struct replace_many_context ctx;
4530562006-03-11Henrik Grubbström (Grubba)  /* NOTE: from and to are only kept for _encode()'s use. */
95489a2008-06-29Martin Nilsson  PIKEVAR array from flags ID_PROTECTED; PIKEVAR array to flags ID_PROTECTED;
fed7de2001-06-28Henrik Grubbström (Grubba) 
2687f92013-09-20Per Hedbor  PIKEFUN int _size_object() { int res = 0, i; if( THIS->ctx.v ) {
b9fd7f2013-09-23Per Hedbor  struct svalue tmp;
86d4ae2014-06-24Henrik Grubbström (Grubba)  SET_SVAL_TYPE(tmp, PIKE_T_STRING);
2687f92013-09-20Per Hedbor  for( i=0; i<THIS->ctx.num; i++ )
b9fd7f2013-09-23Per Hedbor  { 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 ); }
2687f92013-09-20Per Hedbor  } RETURN res; }
6f6d2b2006-03-11Henrik Grubbström (Grubba)  /*! @decl void create(array(string)|mapping(string:string)|void from, @ *! array(string)|string|void to)
18c2252003-04-10Martin Nilsson  */
6f6d2b2006-03-11Henrik Grubbström (Grubba)  PIKEFUN void create(array(string)|mapping(string:string)|void from_arg, array(string)|string|void to_arg)
fed7de2001-06-28Henrik Grubbström (Grubba)  {
a830442008-06-17Martin Stjernholm  if (THIS->from) { free_array(THIS->from); THIS->from = NULL; } if (THIS->to) { free_array(THIS->to); THIS->to = NULL; }
5ca4cf2008-06-19Martin Stjernholm  if (THIS->ctx.v)
a830442008-06-17Martin Stjernholm  free_replace_many_context(&THIS->ctx);
6f6d2b2006-03-11Henrik Grubbström (Grubba) 
f01b122001-07-01Henrik Grubbström (Grubba)  if (!args) { push_int(0); return; }
017b572011-10-28Henrik Grubbström (Grubba)  if (from_arg && TYPEOF(*from_arg) == T_MAPPING) {
6f6d2b2006-03-11Henrik Grubbström (Grubba)  if (to_arg) { Pike_error("Bad number of arguments to create().\n"); } THIS->from = mapping_indices(from_arg->u.mapping); THIS->to = mapping_values(from_arg->u.mapping); pop_n_elems(args); args = 0; } else { /* FIXME: Why is from declared |void, when it isn't allowed * to be void? * /grubba 2004-09-02
340c152008-06-18Martin Stjernholm  * * It probably has to do with the "if (!args)" above: It should * be possible to create an empty instance. /mast
6f6d2b2006-03-11Henrik Grubbström (Grubba)  */ if (!from_arg || !to_arg) { Pike_error("Bad number of arguments to create().\n"); } pop_n_elems(args-2); args = 2;
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*from_arg) != T_ARRAY) {
de22f72014-08-25Martin Nilsson  SIMPLE_BAD_ARG_ERROR("replace", 1,
6f6d2b2006-03-11Henrik Grubbström (Grubba)  "array(string)|mapping(string:string)"); }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*to_arg) == T_STRING) {
6f6d2b2006-03-11Henrik Grubbström (Grubba)  push_int(from_arg->u.array->size); stack_swap(); f_allocate(2); }
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*to_arg) != T_ARRAY) {
de22f72014-08-25Martin Nilsson  SIMPLE_BAD_ARG_ERROR("replace", 2, "array(string)|string");
6f6d2b2006-03-11Henrik Grubbström (Grubba)  } 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);
fed7de2001-06-28Henrik Grubbström (Grubba)  }
c5e2a42004-04-30Martin Nilsson 
6f6d2b2006-03-11Henrik Grubbström (Grubba)  if (!THIS->from->size) {
d5c9e22005-01-07Henrik Grubbström (Grubba)  /* Enter no-op mode. */ pop_n_elems(args); push_int(0); return; }
6f6d2b2006-03-11Henrik Grubbström (Grubba)  if( (THIS->from->type_field & ~BIT_STRING) && (array_fix_type_field(THIS->from) & ~BIT_STRING) )
de22f72014-08-25Martin Nilsson  SIMPLE_BAD_ARG_ERROR("replace", 1,
6f6d2b2006-03-11Henrik Grubbström (Grubba)  "array(string)|mapping(string:string)");
fed7de2001-06-28Henrik Grubbström (Grubba) 
6f6d2b2006-03-11Henrik Grubbström (Grubba)  if( (THIS->to->type_field & ~BIT_STRING) && (array_fix_type_field(THIS->to) & ~BIT_STRING) )
de22f72014-08-25Martin Nilsson  SIMPLE_BAD_ARG_ERROR("replace", 2, "array(string)|string");
fed7de2001-06-28Henrik Grubbström (Grubba) 
6f6d2b2006-03-11Henrik Grubbström (Grubba)  compile_replace_many(&THIS->ctx, THIS->from, THIS->to, 1);
1922b12004-04-30Martin Nilsson 
6f6d2b2006-03-11Henrik Grubbström (Grubba)  pop_n_elems(args); push_int(0);
fed7de2001-06-28Henrik Grubbström (Grubba)  }
18c2252003-04-10Martin Nilsson  /*! @decl string `()(string str) */
fed7de2001-06-28Henrik Grubbström (Grubba)  PIKEFUN string `()(string str) {
6f6d2b2006-03-11Henrik Grubbström (Grubba)  if (!THIS->ctx.v) {
4530562006-03-11Henrik Grubbström (Grubba)  /* The result is already on the stack in the correct place... */ return;
fed7de2001-06-28Henrik Grubbström (Grubba)  }
6f6d2b2006-03-11Henrik Grubbström (Grubba)  RETURN execute_replace_many(&THIS->ctx, str);
fed7de2001-06-28Henrik Grubbström (Grubba)  }
6f6d2b2006-03-11Henrik Grubbström (Grubba)  /*! @decl array(array(string)) _encode()
18c2252003-04-10Martin Nilsson  */
6f6d2b2006-03-11Henrik Grubbström (Grubba)  PIKEFUN array(array(string)) _encode()
9f91572001-07-01Henrik Grubbström (Grubba)  {
6f6d2b2006-03-11Henrik Grubbström (Grubba)  if (THIS->from) { ref_push_array(THIS->from); } else { push_undefined();
9f91572001-07-01Henrik Grubbström (Grubba)  }
6f6d2b2006-03-11Henrik Grubbström (Grubba)  if (THIS->to) { ref_push_array(THIS->to); } else { push_undefined();
9f91572001-07-01Henrik Grubbström (Grubba)  } f_aggregate(2); }
18c2252003-04-10Martin Nilsson  /*! @decl void _decode(array(array(string)) encoded) */
9f91572001-07-01Henrik Grubbström (Grubba)  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); }
fed7de2001-06-28Henrik Grubbström (Grubba)  INIT {
21b12a2014-09-03Martin Nilsson  memset(&THIS->ctx, 0, sizeof(struct replace_many_context));
fed7de2001-06-28Henrik Grubbström (Grubba)  } EXIT
8dcb7d2008-05-29Martin Stjernholm  gc_trivial;
fed7de2001-06-28Henrik Grubbström (Grubba)  {
6f6d2b2006-03-11Henrik Grubbström (Grubba)  free_replace_many_context(&THIS->ctx);
fed7de2001-06-28Henrik Grubbström (Grubba)  } } /*! @endclass */
0c4ad02001-07-05Henrik Grubbström (Grubba) /*! @class SingleReplace
c5e2a42004-04-30Martin Nilsson  *! *! 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.
0c4ad02001-07-05Henrik Grubbström (Grubba)  */ PIKECLASS single_string_replace { CVAR SearchMojt mojt;
95489a2008-06-29Martin Nilsson  PIKEVAR string del flags ID_PROTECTED|ID_PRIVATE; PIKEVAR string to flags ID_PROTECTED|ID_PRIVATE;
0c4ad02001-07-05Henrik Grubbström (Grubba) 
8910312008-06-23Martin Stjernholm  EXTRA {
95489a2008-06-29Martin Nilsson  MAP_VARIABLE ("o", tObj, ID_PROTECTED|ID_PRIVATE,
8910312008-06-23Martin Stjernholm  single_string_replace_storage_offset + OFFSETOF (single_string_replace_struct, mojt.container), T_OBJECT); }
45e13d2008-06-23Martin Stjernholm  /*! @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)
0c4ad02001-07-05Henrik Grubbström (Grubba)  { if (THIS->del) { free_string(THIS->del); THIS->del = NULL; } if (THIS->to) { free_string(THIS->to); THIS->to = NULL; }
fe21442004-09-02Henrik Grubbström (Grubba)  if (!del) return;
0c4ad02001-07-05Henrik Grubbström (Grubba) 
fe21442004-09-02Henrik Grubbström (Grubba)  if (!to) {
de22f72014-08-25Martin Nilsson  SIMPLE_BAD_ARG_ERROR("replace", 2, "string");
0c4ad02001-07-05Henrik Grubbström (Grubba)  }
fe21442004-09-02Henrik Grubbström (Grubba)  if (del == to) {
0c4ad02001-07-05Henrik Grubbström (Grubba)  /* No-op... */ return; }
fe21442004-09-02Henrik Grubbström (Grubba)  copy_shared_string(THIS->del, del); copy_shared_string(THIS->to, to);
0c4ad02001-07-05Henrik Grubbström (Grubba)  if (del->len) {
50edc82001-07-13Henrik Grubbström (Grubba)  THIS->mojt = simple_compile_memsearcher(del);
0c4ad02001-07-05Henrik Grubbström (Grubba)  } } /*** replace function ***/ typedef char *(* replace_searchfunc)(void *,void *,size_t);
18c2252003-04-10Martin Nilsson  /*! @decl string `()(string str) */
0c4ad02001-07-05Henrik Grubbström (Grubba)  PIKEFUN string `()(string str) { int shift; struct pike_string *del = THIS->del; struct pike_string *to = THIS->to; struct pike_string *ret = NULL; if (!str->len || !del || !to) { /* The result is already on the stack in the correct place... */ return; } shift = MAXIMUM(str->size_shift, to->size_shift); if (!del->len) { int e, pos; ret = begin_wide_shared_string(str->len + to->len * (str->len-1), shift); low_set_index(ret, 0, index_shared_string(str, 0)); for(pos=e=1;e<str->len;e++) { pike_string_cpy(MKPCHARP_STR_OFF(ret,pos), to); pos+=to->len; low_set_index(ret,pos++,index_shared_string(str,e)); } } else { char *s, *end, *tmp; replace_searchfunc f = (replace_searchfunc)0; void *mojt_data = THIS->mojt.data; PCHARP r; end = str->str+(str->len<<str->size_shift); switch(str->size_shift) { case 0: f = (replace_searchfunc)THIS->mojt.vtab->func0; break; case 1: f = (replace_searchfunc)THIS->mojt.vtab->func1; break; case 2: f = (replace_searchfunc)THIS->mojt.vtab->func2; break; #ifdef PIKE_DEBUG
5aad932002-08-15Marcus Comstedt  default: Pike_fatal("Illegal shift.\n");
0c4ad02001-07-05Henrik Grubbström (Grubba) #endif } if(del->len == to->len) { ret = begin_wide_shared_string(str->len, shift); } else { INT32 delimiters = 0; s = str->str; while((s = f(mojt_data, s, (end-s)>>str->size_shift))) { delimiters++; s += del->len << str->size_shift; } if (!delimiters) { /* The result is already on the stack in the correct place... */ return; } ret = begin_wide_shared_string(str->len + (to->len-del->len)*delimiters, shift); } s = str->str; r = MKPCHARP_STR(ret); while((tmp = f(mojt_data, s, (end-s)>>str->size_shift))) { #ifdef PIKE_DEBUG if(tmp + (del->len << str->size_shift) > end)
362d302004-03-08Martin Nilsson  Pike_fatal("SearchMojt found a match beyond end of string!\n");
0c4ad02001-07-05Henrik Grubbström (Grubba) #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); }
18c2252003-04-10Martin Nilsson  /*! @decl array(string) _encode() */
0c4ad02001-07-05Henrik Grubbström (Grubba)  PIKEFUN array(string) _encode() { if (THIS->del) { ref_push_string(THIS->del); ref_push_string(THIS->to); f_aggregate(2); } else { push_int(0); } }
18c2252003-04-10Martin Nilsson  /*! @decl void _decode(array(string)|int(0..0) encoded) */
0c4ad02001-07-05Henrik Grubbström (Grubba)  PIKEFUN void _decode(array(string)|int(0..0) encoded_) { INT32 i = 0;
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*encoded_) == PIKE_T_ARRAY) {
0c4ad02001-07-05Henrik Grubbström (Grubba)  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 */
19f7672003-02-18Marcus Comstedt /*! @class Bootstring
3715ee2003-02-19Marcus Comstedt  *! *! This class implements the "Bootstring" string transcoder described in
abf31d2003-09-11Marcus Comstedt  *! @url{ftp://ftp.rfc-editor.org/in-notes/rfc3492.txt@}.
19f7672003-02-18Marcus Comstedt  */ PIKECLASS bootstring { CVAR INT_TYPE base, tmin, tmax, skew, damp; CVAR INT_TYPE initial_bias, initial_n; CVAR p_wchar2 delim;
95489a2008-06-29Martin Nilsson  PIKEVAR string digits flags ID_PROTECTED|ID_PRIVATE;
19f7672003-02-18Marcus Comstedt  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); }
3715ee2003-02-19Marcus Comstedt  /*! @decl string decode(string s) *! *! Decodes a Bootstring encoded string of "basic" code points back *! to the original string space. */
19f7672003-02-18Marcus Comstedt  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];
1abbfb2006-07-05Martin Stjernholm  s[p] = DO_NOT_WARN ((p_wchar0) n);
19f7672003-02-18Marcus Comstedt  } break; case 1: { p_wchar1 *s = STR1(output.s); INT_TYPE p = output.s->len; while (--p>i) s[p] = s[p-1];
1abbfb2006-07-05Martin Stjernholm  s[p] = DO_NOT_WARN ((p_wchar1) n);
19f7672003-02-18Marcus Comstedt  } break; case 2: { p_wchar2 *s = STR2(output.s); INT_TYPE p = output.s->len; while (--p>i) s[p] = s[p-1];
1abbfb2006-07-05Martin Stjernholm  s[p] = DO_NOT_WARN ((p_wchar2) n);
19f7672003-02-18Marcus Comstedt  } break;
c6b6042008-05-03Martin Nilsson #ifdef PIKE_DEBUG
19f7672003-02-18Marcus Comstedt  default: Pike_fatal("Illegal shift size!\n");
c6b6042008-05-03Martin Nilsson #endif
19f7672003-02-18Marcus Comstedt  } i++; } RETURN finish_string_builder( &output ); }
3715ee2003-02-19Marcus Comstedt  /*! @decl string encode(string s) *! *! Encodes a string using Bootstring encoding into a string constisting *! only of "basic" code points (< initial_n). */
19f7672003-02-18Marcus Comstedt  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 ); }
3715ee2003-02-19Marcus Comstedt  /*! @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
1ae3d62003-02-19Henrik Grubbström (Grubba)  *! The damping factor for the bias adaption. Must be >= 2.
3715ee2003-02-19Marcus Comstedt  *! @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. */
19f7672003-02-18Marcus Comstedt  PIKEFUN void create( int base, int tmin, int tmax, int skew, int damp, int initial_bias, int initial_n, int delim, string digits )
95489a2008-06-29Martin Nilsson  flags ID_PROTECTED;
19f7672003-02-18Marcus Comstedt  { struct bootstring_struct *bs = THIS;
3715ee2003-02-19Marcus Comstedt  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");
19f7672003-02-18Marcus Comstedt  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 */
fed7de2001-06-28Henrik Grubbström (Grubba) /*! @endmodule */
a3c4332001-06-20Per Hedbor 
da90692002-11-26Henrik Grubbström (Grubba) /*! @module System */ /*! @class Time *! *! The current time as a structure containing a sec and a usec *! member. */ PIKECLASS Time { CVAR int hard_update;
c329cb2011-02-15Martin Nilsson 
1fde1f2011-02-16Henrik Grubbström (Grubba)  /*! @decl int sec *! @decl int usec
da90692002-11-26Henrik Grubbström (Grubba)  *! *! The number of seconds and microseconds since the epoch and the *! last whole second, respectively. (See also @[predef::time()]) *!
1fde1f2011-02-16Henrik Grubbström (Grubba)  *! @note
da90692002-11-26Henrik Grubbström (Grubba)  *! Please note that these variables will continually update when *! they are requested, there is no need to create new Time() *! objects. */
1fde1f2011-02-16Henrik Grubbström (Grubba)  PIKEFUN int `sec() {
f010202011-11-16Tobias S. Josefowitz  struct timeval now;
1fde1f2011-02-16Henrik Grubbström (Grubba)  if( THIS->hard_update )
f010202011-11-16Tobias S. Josefowitz  ACCURATE_GETTIMEOFDAY( &now ); else INACCURATE_GETTIMEOFDAY( &now );
1fde1f2011-02-16Henrik Grubbström (Grubba) 
f010202011-11-16Tobias S. Josefowitz  RETURN now.tv_sec;
1fde1f2011-02-16Henrik Grubbström (Grubba)  } PIKEFUN int `usec() {
f010202011-11-16Tobias S. Josefowitz  struct timeval now;
1fde1f2011-02-16Henrik Grubbström (Grubba)  if( THIS->hard_update )
f010202011-11-16Tobias S. Josefowitz  ACCURATE_GETTIMEOFDAY( &now ); else INACCURATE_GETTIMEOFDAY( &now );
1fde1f2011-02-16Henrik Grubbström (Grubba) 
f010202011-11-16Tobias S. Josefowitz  RETURN now.tv_usec;
1fde1f2011-02-16Henrik Grubbström (Grubba)  } /*! @decl int usec_full
da90692002-11-26Henrik Grubbström (Grubba)  *! *! The number of microseconds since the epoch. Please note that
1fde1f2011-02-16Henrik Grubbström (Grubba)  *! pike needs to have been compiled with bignum support for this
da90692002-11-26Henrik Grubbström (Grubba)  *! variable to contain sensible values. */
1fde1f2011-02-16Henrik Grubbström (Grubba)  PIKEFUN int `usec_full()
da90692002-11-26Henrik Grubbström (Grubba)  {
f010202011-11-16Tobias S. Josefowitz  struct timeval now;
da90692002-11-26Henrik Grubbström (Grubba)  if( THIS->hard_update )
f010202011-11-16Tobias S. Josefowitz  ACCURATE_GETTIMEOFDAY( &now ); else INACCURATE_GETTIMEOFDAY( &now );
da90692002-11-26Henrik Grubbström (Grubba) 
f010202011-11-16Tobias S. Josefowitz  push_int( now.tv_sec );
da90692002-11-26Henrik Grubbström (Grubba)  push_int( 1000000 ); f_multiply( 2 );
f010202011-11-16Tobias S. Josefowitz  push_int( now.tv_usec );
da90692002-11-26Henrik Grubbström (Grubba)  f_add( 2 ); return; }
c329cb2011-02-15Martin Nilsson 
30c0612008-06-29Martin Stjernholm  /*! @decl protected void create( int fast );
da90692002-11-26Henrik Grubbström (Grubba)  *!
c834442008-05-29Martin Stjernholm  *! If @[fast] is true, do not request a new time from the system,
da90692002-11-26Henrik Grubbström (Grubba)  *! instead use the global current time variable. *! *! This will only work in callbacks, but can save significant amounts *! of CPU. */
c834442008-05-29Martin Stjernholm  PIKEFUN void create( int|zero|void fast )
1fde1f2011-02-16Henrik Grubbström (Grubba)  flags ID_PROTECTED;
da90692002-11-26Henrik Grubbström (Grubba)  { 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( ) {
f010202011-11-16Tobias S. Josefowitz  struct timeval now;
da90692002-11-26Henrik Grubbström (Grubba)  FLOAT_TYPE res; if( THIS->hard_update )
f010202011-11-16Tobias S. Josefowitz  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;
da90692002-11-26Henrik Grubbström (Grubba)  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 );
f010202011-11-16Tobias S. Josefowitz  INACCURATE_GETTIMEOFDAY(&THIS->last_time);
da90692002-11-26Henrik Grubbström (Grubba)  return; }
30c0612008-06-29Martin Stjernholm  /*! @decl protected void create( int|void fast )
da90692002-11-26Henrik Grubbström (Grubba)  *! Create a new timer object. The timer keeps track of relative time *! with sub-second precision. *!
c834442008-05-29Martin Stjernholm  *! If @[fast] is specified, the timer will not do system calls to get
da90692002-11-26Henrik Grubbström (Grubba)  *! the current time but instead use the one maintained by pike. This
c834442008-05-29Martin Stjernholm  *! 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.
da90692002-11-26Henrik Grubbström (Grubba)  */
c834442008-05-29Martin Stjernholm  PIKEFUN void create( int|zero|void fast )
13a9fc2011-02-16Henrik Grubbström (Grubba)  flags ID_PROTECTED;
da90692002-11-26Henrik Grubbström (Grubba)  { THIS->hard_update = !fast; if( THIS->hard_update )
f010202011-11-16Tobias S. Josefowitz  ACCURATE_GETTIMEOFDAY( &THIS->last_time ); else INACCURATE_GETTIMEOFDAY( &THIS->last_time );
da90692002-11-26Henrik Grubbström (Grubba)  } } /*! @endclass */ /*! @endmodule */
8bef1b2001-09-27Fredrik Hübinette (Hubbe) 
897e622013-11-19Henrik Grubbström (Grubba) /*! @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()] */
8bef1b2001-09-27Fredrik Hübinette (Hubbe) PIKECLASS automap_marker { PIKEVAR array arg; PIKEVAR int depth;
897e622013-11-19Henrik Grubbström (Grubba)  /*! @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. */
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  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);
e6dbc22002-11-29Marcus Comstedt  if (mode != 'O') { push_undefined (); return; }
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  push_text("%O%*'[*]'n"); if(THIS->arg) ref_push_array(THIS->arg); else push_int(0); push_int(THIS->depth*3); f_sprintf(3); } }
897e622013-11-19Henrik Grubbström (Grubba) /*! @endclass */ /*! @endmodule */
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  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;
2523ce2003-04-28Martin Stjernholm  TYPE_FIELD types;
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  for(e=0;e<args;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(real_args[e]) == T_OBJECT &&
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  real_args[e].u.object->prog == automap_marker_program && OBJ2_AUTOMAP_MARKER(real_args[e].u.object)->depth >= d) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(tmpargs[e]) != T_ARRAY)
a241e02001-09-27Fredrik Hübinette (Hubbe)  index_error("__automap__", Pike_sp-args, args, tmpargs, NULL, "Automap on non-array.\n");
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  tmp=tmpargs[e].u.array->size; if(tmp < size) size=tmp; } }
897e622013-11-19Henrik Grubbström (Grubba)  if(size == 0x7fffffff) Pike_error("No automap markers found in __automap__\n");
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  push_array(ret=allocate_array(size));
2523ce2003-04-28Martin Stjernholm  types = 0;
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  for(x=0;x<size;x++) { for(e=0;e<args;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(real_args[e]) == T_OBJECT &&
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  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)
5aad932002-08-15Marcus Comstedt  Pike_fatal("low_automap failed to determine size!\n");
8bef1b2001-09-27Fredrik Hübinette (Hubbe) #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);
2523ce2003-04-28Martin Stjernholm  stack_pop_to_no_free (ITEM(ret) + x);
017b572011-10-28Henrik Grubbström (Grubba)  types |= 1 << TYPEOF(ITEM(ret)[x]);
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  }
2523ce2003-04-28Martin Stjernholm  ret->type_field = types;
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  stack_unlink(args); }
897e622013-11-19Henrik Grubbström (Grubba) /*! @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()] */
8bef1b2001-09-27Fredrik Hübinette (Hubbe) PIKEFUN array __automap__(mixed fun, mixed ... tmpargs) efun; { int e,depth=-1; check_stack(args); for(e=0;e<args-1;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(tmpargs[e]) == T_OBJECT &&
8bef1b2001-09-27Fredrik Hübinette (Hubbe)  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); }
e796b22011-01-07Henrik Grubbström (Grubba) /*! @module Builtin
dbe50e2009-11-09Henrik Grubbström (Grubba)  */
6f321c2011-01-20Henrik Grubbström (Grubba) /*! @class Setter *! *! Internal class for implementing setters.
35ce662013-11-16Henrik Grubbström (Grubba)  *! *! This class is used by @[_get_setter()]. *! *! @seealso *! @[_get_setter()]
6f321c2011-01-20Henrik Grubbström (Grubba)  */ PIKECLASS Setter { PIKEVAR object o flags ID_PROTECTED|ID_PRIVATE|ID_LOCAL; CVAR int f;
35ce662013-11-16Henrik Grubbström (Grubba)  /*! @decl void `()(mixed val) *! *! Set the variable for the setter to @[val]. *! *! This is the function returned by @[_get_setter()]. */
6f321c2011-01-20Henrik Grubbström (Grubba)  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) {
7cf0162014-05-22Per Hedbor  push_text("Setter()");
6f321c2011-01-20Henrik Grubbström (Grubba)  } else if ((prog = THIS->o->prog)) {
7cf0162014-05-22Per Hedbor  push_text("%O->`%s=");
6f321c2011-01-20Henrik Grubbström (Grubba)  ref_push_object(THIS->o); ref_push_string(ID_FROM_INT(prog, THIS->f)->name); f_sprintf(3); } else {
7cf0162014-05-22Per Hedbor  push_text("Setter(destructed object)");
6f321c2011-01-20Henrik Grubbström (Grubba)  } stack_pop_n_elems_keep_top(args); } }
35ce662013-11-16Henrik Grubbström (Grubba) /*! @endclass */
6f321c2011-01-20Henrik Grubbström (Grubba) 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; }
35ce662013-11-16Henrik Grubbström (Grubba) /*! @decl function(mixed_void) _get_setter(object o, string varname)
6f321c2011-01-20Henrik Grubbström (Grubba)  *!
35ce662013-11-16Henrik Grubbström (Grubba)  *! 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.
6f321c2011-01-20Henrik Grubbström (Grubba)  *! *! @seealso *! @[object_variablep()] */ PIKEFUN function(mixed:void) _get_setter(object o, string s) { struct program *p;
4dbbd22011-01-21Henrik Grubbström (Grubba)  struct inherit *inh;
6f321c2011-01-20Henrik Grubbström (Grubba)  int f; if (!(p = o->prog)) { Pike_error("Indexing a destructed object.\n"); }
017b572011-10-28Henrik Grubbström (Grubba)  inh = p->inherits + SUBTYPEOF(Pike_sp[-args]);
4dbbd22011-01-21Henrik Grubbström (Grubba)  p = inh->prog;
6f321c2011-01-20Henrik Grubbström (Grubba)  f = find_shared_string_identifier(s, p); if ((f >= 0) && IDENTIFIER_IS_VARIABLE(ID_FROM_INT(p, f)->identifier_flags)) {
4dbbd22011-01-21Henrik Grubbström (Grubba)  f += inh->identifier_level;
6f321c2011-01-20Henrik Grubbström (Grubba)  push_function(get_setter(o, f), f_Setter_cq__backtick_28_29_fun_num); } else { push_undefined(); } stack_pop_n_elems_keep_top(args); }
83045c2011-03-05Martin Stjernholm /*! @class Null
dbe50e2009-11-09Henrik Grubbström (Grubba)  *!
e796b22011-01-07Henrik Grubbström (Grubba)  *! This class is used to implement the low-level aspects of @[Val.Null].
dbe50e2009-11-09Henrik Grubbström (Grubba)  *! *! @note
e796b22011-01-07Henrik Grubbström (Grubba)  *! This class should typically not be used directly. Use *! @[Val.Null] instead. *!
d038542011-01-17Henrik Grubbström (Grubba)  *! @note *! This class was previously available as @[Sql.Null]. Any such use *! should be replaced with @[Val.Null]. *!
e796b22011-01-07Henrik Grubbström (Grubba)  *! @deprecated Val.Null
dbe50e2009-11-09Henrik Grubbström (Grubba)  *! *! @seealso
e796b22011-01-07Henrik Grubbström (Grubba)  *! @[Val.Null], @[Val.null]
dbe50e2009-11-09Henrik Grubbström (Grubba)  */
83045c2011-03-05Martin Stjernholm PIKECLASS Null
dbe50e2009-11-09Henrik Grubbström (Grubba) { EXTRA {
83045c2011-03-05Martin Stjernholm  /*! @decl constant is_val_null = 1 *! *! Nonzero recognition constant. */ add_integer_constant("is_val_null", 1, 0);
dbe50e2009-11-09Henrik Grubbström (Grubba)  /*! @decl constant is_sql_null = 1 *! *! SQL Null marker.
83045c2011-03-05Martin Stjernholm  *! *! @deprecated is_val_null
dbe50e2009-11-09Henrik Grubbström (Grubba)  */ 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') {
7cf0162014-05-22Per Hedbor  push_text("Val.null");
dbe50e2009-11-09Henrik Grubbström (Grubba)  } else { push_undefined(); } }
77865b2009-11-11Henrik Grubbström (Grubba)  PIKEFUN int __hash()
dbe50e2009-11-09Henrik Grubbström (Grubba)  flags ID_PROTECTED; { pop_n_elems(args); push_int(17); } PIKEFUN int `==(mixed other) flags ID_PROTECTED; {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*other) != T_OBJECT) {
dbe50e2009-11-09Henrik Grubbström (Grubba)  pop_stack(); push_int(0); return; }
ace6c92011-03-15Martin Stjernholm  /* 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);
83045c2011-03-05Martin Stjernholm  push_constant_text("is_val_null");
ace6c92011-03-15Martin Stjernholm  if (program_index_no_free (Pike_sp - 3, Pike_sp - 2, Pike_sp - 1) &&
017b572011-10-28Henrik Grubbström (Grubba)  TYPEOF(Pike_sp[-3]) == T_INT && Pike_sp[-3].u.integer) {
ace6c92011-03-15Martin Stjernholm  pop_n_elems (4); push_int (1); } else { pop_n_elems (4); push_int (0); }
dbe50e2009-11-09Henrik Grubbström (Grubba)  }
dce09c2010-05-28Martin Stjernholm  /*! @decl string encode_json() *! *! Defined for use with @[Standards.JSON.encode], so that it *! formats NULL as @expr{null@}. */
b670b42010-05-28Martin Stjernholm  PIKEFUN string encode_json(...)
dce09c2010-05-28Martin Stjernholm  {
dffabf2014-02-24Per Hedbor  pop_n_elems(args);
dce09c2010-05-28Martin Stjernholm  push_constant_text ("null"); }
dbe50e2009-11-09Henrik Grubbström (Grubba) } /*! @endclass */
3dce7d2013-04-30Markus Ottensmann 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]; }
dbe50e2009-11-09Henrik Grubbström (Grubba) /*! @endmodule */
1031362011-01-21Henrik Grubbström (Grubba) /*! @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 {
fe7f0e2014-02-17Henrik Grubbström (Grubba)  /* Loop over all true variables, and call fun_num in the current object. */
6220962011-01-28Henrik Grubbström (Grubba)  static void low_serialize(int i, struct svalue *fun, int use_setter, int fun_num)
1031362011-01-21Henrik Grubbström (Grubba)  { 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);
fe7f0e2014-02-17Henrik Grubbström (Grubba)  if (!IDENTIFIER_IS_VARIABLE(id->identifier_flags) || (id->run_time_type == PIKE_T_GET_SET)) {
1031362011-01-21Henrik Grubbström (Grubba)  continue; }
6220962011-01-28Henrik Grubbström (Grubba)  push_svalue(fun);
1031362011-01-21Henrik Grubbström (Grubba)  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++; }
9cded82011-02-04Henrik Grubbström (Grubba)  ref_push_string(id->name); ref_push_type_value(id->type);
6220962011-01-28Henrik Grubbström (Grubba)  apply_current(fun_num, 4);
1031362011-01-21Henrik Grubbström (Grubba)  pop_stack(); } if (Pike_sp != save_sp) { /* Not likely, but... */ pop_n_elems(Pike_sp - save_sp); } }
d6ec7c2011-01-29Henrik Grubbström (Grubba)  /*! @decl protected void _serialize_variable( @
9cded82011-02-04Henrik Grubbström (Grubba)  *! function(mixed, string, type:void) serializer, @ *! mixed value, @
d6ec7c2011-01-29Henrik Grubbström (Grubba)  *! string symbol, @
9cded82011-02-04Henrik Grubbström (Grubba)  *! type symbol_type)
6220962011-01-28Henrik Grubbström (Grubba)  *! *! Default serialization function for variables. *! *! @param serializer *! Function to be called in turn. *!
9cded82011-02-04Henrik Grubbström (Grubba)  *! @param value *! Value of the variable. *!
6220962011-01-28Henrik Grubbström (Grubba)  *! @param symbol *! Variable name. *! *! @param symbol_type *! Type of the variable. *! *! This function is typically called from @[_serialize()], and just does *! @code
9cded82011-02-04Henrik Grubbström (Grubba)  *! serializer(value, symbol, symbol_type);
6220962011-01-28Henrik Grubbström (Grubba)  *! @endcode *! *! It is provided for overloading for eg filtering or validation purposes. *! *! @seealso *! @[_serialize()], @[_deserialize_variable()] */
9cded82011-02-04Henrik Grubbström (Grubba)  PIKEFUN void _serialize_variable(function(mixed, string, type:void) serializer, mixed value, string symbol, type symbol_type)
6220962011-01-28Henrik Grubbström (Grubba)  flags ID_PROTECTED;
9cded82011-02-04Henrik Grubbström (Grubba)  rawtype tFunc(tFunc(tMix tStr tType(tMix), tVoid) tMix tStr tType(tMix), tVoid);
6220962011-01-28Henrik Grubbström (Grubba)  { f_call_function(args); pop_stack(); push_int(0); }
d6ec7c2011-01-29Henrik Grubbström (Grubba)  /*! @decl protected void _serialize(object o, @
9cded82011-02-04Henrik Grubbström (Grubba)  *! function(mixed, string, type:void) serializer)
1031362011-01-21Henrik Grubbström (Grubba)  *! *! Dispatch function for serialization. *! *! @param o *! Object to serialize. Always a context of the current object. *! *! @param serializer
6220962011-01-28Henrik Grubbström (Grubba)  *! Function to typically be called once for every variable
1031362011-01-21Henrik Grubbström (Grubba)  *! in the inheriting class. *!
6220962011-01-28Henrik Grubbström (Grubba)  *! This function calls @[_serialize_variable()] once
aad25e2013-11-16Henrik Grubbström (Grubba)  *! 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
1031362011-01-21Henrik Grubbström (Grubba)  *! *! @note *! The symbols will be listed in the order they were defined *! in the class. *! *! @note *! This function is typically called via @[Serializer.serialize()].
aad25e2013-11-16Henrik Grubbström (Grubba)  *! *! @seealso *! @[Serializer.serialize()], @[_serialize_variable()], *! @[_deserialize()]
1031362011-01-21Henrik Grubbström (Grubba)  */ PIKEFUN void _serialize(object o,
9cded82011-02-04Henrik Grubbström (Grubba)  function(mixed, string, type:void) serializer)
1031362011-01-21Henrik Grubbström (Grubba)  flags ID_PROTECTED;
9cded82011-02-04Henrik Grubbström (Grubba)  rawtype tFunc(tObj tFunc(tMix tStr tType(tMix), tVoid), tVoid);
1031362011-01-21Henrik Grubbström (Grubba)  { if (o != Pike_fp->current_object) { SIMPLE_BAD_ARG_ERROR("_serialize", 1, "this"); }
017b572011-10-28Henrik Grubbström (Grubba)  low_serialize(SUBTYPEOF(Pike_sp[-args]), serializer, 0,
6220962011-01-28Henrik Grubbström (Grubba)  f_Serializable_cq__serialize_variable_fun_num);
1031362011-01-21Henrik Grubbström (Grubba)  pop_n_elems(args); push_int(0); }
80095c2011-01-28Henrik Grubbström (Grubba)  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);
d6ec7c2011-01-29Henrik Grubbström (Grubba)  /*! @decl protected void _deserialize_variable( @
9cded82011-02-04Henrik Grubbström (Grubba)  *! function(function(mixed:void), @ *! string, type: void) deserializer, @ *! function(mixed:void) setter, @
d6ec7c2011-01-29Henrik Grubbström (Grubba)  *! string symbol, @
9cded82011-02-04Henrik Grubbström (Grubba)  *! type symbol_type)
6220962011-01-28Henrik Grubbström (Grubba)  *! *! Default deserialization function for variables. *! *! @param deserializer *! Function to be called in turn. *!
9cded82011-02-04Henrik Grubbström (Grubba)  *! @param setter *! Function that sets the value of the variable. *!
6220962011-01-28Henrik Grubbström (Grubba)  *! @param symbol *! Variable name. *! *! @param symbol_type *! Type of the variable. *!
80095c2011-01-28Henrik Grubbström (Grubba)  *! This function is typically called from @[_deserialize()], and does *! something like:
6220962011-01-28Henrik Grubbström (Grubba)  *! @code
80095c2011-01-28Henrik Grubbström (Grubba)  *! 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; *! } *! }
9cded82011-02-04Henrik Grubbström (Grubba)  *! deserializer(setter, symbol, symbol_type);
6220962011-01-28Henrik Grubbström (Grubba)  *! @endcode *!
80095c2011-01-28Henrik Grubbström (Grubba)  *! @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.
6220962011-01-28Henrik Grubbström (Grubba)  *! *! @seealso
aad25e2013-11-16Henrik Grubbström (Grubba)  *! @[_deserialize()], @[_serialize_variable()], @[Builtin.Setter]
6220962011-01-28Henrik Grubbström (Grubba)  */
9cded82011-02-04Henrik Grubbström (Grubba)  PIKEFUN void _deserialize_variable(function(function(mixed:void), string, type: void) deserializer, function(mixed:void) setter, string symbol, type symbol_type)
6220962011-01-28Henrik Grubbström (Grubba)  flags ID_PROTECTED;
9cded82011-02-04Henrik Grubbström (Grubba)  rawtype tFunc(tFunc(tFunc(tMix, tVoid) tStr tType(tMix), tVoid) tFunc(tMix, tVoid) tStr tType(tMix), tVoid);
6220962011-01-28Henrik Grubbström (Grubba)  {
80095c2011-01-28Henrik Grubbström (Grubba)  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; }
6220962011-01-28Henrik Grubbström (Grubba)  f_call_function(args); pop_stack(); push_int(0); }
d6ec7c2011-01-29Henrik Grubbström (Grubba)  /*! @decl protected void _deserialize(object o, @
9cded82011-02-04Henrik Grubbström (Grubba)  *! function(function(mixed:void), @ *! string, type: void) deserializer)
1031362011-01-21Henrik Grubbström (Grubba)  *! *! Dispatch function for deserialization. *! *! @param o *! Object to serialize. Always a context of the current object. *! *! @param deserializer
6220962011-01-28Henrik Grubbström (Grubba)  *! Function to typically be called once for every variable
1031362011-01-21Henrik Grubbström (Grubba)  *! in the inheriting class. *!
6220962011-01-28Henrik Grubbström (Grubba)  *! This function calls @[_deserialize_variable()] once
aad25e2013-11-16Henrik Grubbström (Grubba)  *! 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
1031362011-01-21Henrik Grubbström (Grubba)  *! *! @note *! The symbols will be listed in the order they were defined *! in the class. *! *! @note *! This function is typically called via @[Serializer.deserialize()].
aad25e2013-11-16Henrik Grubbström (Grubba)  *! *! @seealso *! @[Serializer.deserialize()], @[_deserialize_variable()], *! @[_serialize()], @[Builtin.Setter]
1031362011-01-21Henrik Grubbström (Grubba)  */ PIKEFUN void _deserialize(object o,
9cded82011-02-04Henrik Grubbström (Grubba)  function(function(mixed:void), string, type: void) deserializer)
1031362011-01-21Henrik Grubbström (Grubba)  flags ID_PROTECTED;
9cded82011-02-04Henrik Grubbström (Grubba)  rawtype tFunc(tObj tFunc(tFunc(tMix, tVoid) tStr tType(tMix), tVoid), tVoid);
1031362011-01-21Henrik Grubbström (Grubba)  { if (o != Pike_fp->current_object) { SIMPLE_BAD_ARG_ERROR("_serialize", 1, "this"); }
017b572011-10-28Henrik Grubbström (Grubba)  low_serialize(SUBTYPEOF(Pike_sp[-args]), deserializer, 1,
6220962011-01-28Henrik Grubbström (Grubba)  f_Serializable_cq__deserialize_variable_fun_num);
1031362011-01-21Henrik Grubbström (Grubba)  pop_n_elems(args); push_int(0); } } /*! @endclass */ /*! @decl void serialize(object o, @
9cded82011-02-04Henrik Grubbström (Grubba)  *! function(mixed, string, type:void) serializer)
1031362011-01-21Henrik Grubbström (Grubba)  *!
0d47c72011-01-22Henrik Grubbström (Grubba)  *! Call @[lfun::_serialize()] in @[o].
1031362011-01-21Henrik Grubbström (Grubba)  *! *! @seealso
0d47c72011-01-22Henrik Grubbström (Grubba)  *! @[deserialize()], @[lfun::_serialize()],
1031362011-01-21Henrik Grubbström (Grubba)  *! @[Serializable()->_serialize()] */ PIKEFUN void serialize(object o,
9cded82011-02-04Henrik Grubbström (Grubba)  function(mixed, string, type:void) serializer) rawtype tFunc(tObj tFunc(tMix tStr tType(tMix), tVoid), tVoid);
1031362011-01-21Henrik Grubbström (Grubba) { struct inherit *inh; struct program *p; ptrdiff_t fun; if (!(p = o->prog)) { Pike_error("Indexing a destructed object.\n"); }
017b572011-10-28Henrik Grubbström (Grubba)  inh = p->inherits + SUBTYPEOF(Pike_sp[-args]);
1031362011-01-21Henrik Grubbström (Grubba)  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, @
9cded82011-02-04Henrik Grubbström (Grubba)  *! function(function(mixed:void), @ *! string, type: void) deserializer)
1031362011-01-21Henrik Grubbström (Grubba)  *!
0d47c72011-01-22Henrik Grubbström (Grubba)  *! Call @[lfun::_deserialize()] in @[o].
1031362011-01-21Henrik Grubbström (Grubba)  *! *! @seealso
0d47c72011-01-22Henrik Grubbström (Grubba)  *! @[serialize()], @[lfun::_deserialize()],
1031362011-01-21Henrik Grubbström (Grubba)  *! @[Serializable()->_deserialize()] */ PIKEFUN void deserialize(object o,
9cded82011-02-04Henrik Grubbström (Grubba)  function(function(mixed:void), string, type:void) deserializer) rawtype tFunc(tObj tFunc(tFunc(tMix, tVoid) tStr tType(tMix), tVoid), tVoid);
1031362011-01-21Henrik Grubbström (Grubba) { struct inherit *inh; struct program *p; ptrdiff_t fun; if (!(p = o->prog)) { Pike_error("Indexing a destructed object.\n"); }
017b572011-10-28Henrik Grubbström (Grubba)  inh = p->inherits + SUBTYPEOF(Pike_sp[-args]);
1031362011-01-21Henrik Grubbström (Grubba)  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 */
83c38b2004-09-14Henrik Grubbström (Grubba) /*! @module ADT */
7b02672013-11-19Henrik Grubbström (Grubba) /* 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); }
3b54e52014-08-21Martin Nilsson void free_all_pike_list_node_blocks(void) {
7b02672013-11-19Henrik Grubbström (Grubba)  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); }
db628a2004-09-10Henrik Grubbström (Grubba) /*! @class List *! *! Linked list of values. */ PIKECLASS List {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  CVAR struct pike_list_node *head;
db628a2004-09-10Henrik Grubbström (Grubba)  CVAR INT32 head_sentinel_refs;
4b8ebf2008-03-09Henrik Grubbström (Grubba)  CVAR struct pike_list_node *tail; /* Always NULL. */
db628a2004-09-10Henrik Grubbström (Grubba)  CVAR INT32 tail_sentinel_refs;
4b8ebf2008-03-09Henrik Grubbström (Grubba)  CVAR struct pike_list_node *tail_pred;
ce2d402004-09-17Henrik Grubbström (Grubba)  CVAR INT32 num_elems;
db628a2004-09-10Henrik Grubbström (Grubba) 
4b8ebf2008-03-09Henrik Grubbström (Grubba) #define HEAD_SENTINEL(this) ((struct pike_list_node *)(&this->head)) #define TAIL_SENTINEL(this) ((struct pike_list_node *)(&this->tail))
db628a2004-09-10Henrik Grubbström (Grubba) 
cf8d5c2004-09-11Henrik Grubbström (Grubba)  /* Sentinel overlap description: * * List Head sentinel Tail sentinel * head next * head_sentinel_refs refs * tail prev next * tail_sentinel_refs refs * tail_pred prev */
d3438c2004-09-12Henrik Grubbström (Grubba)  /* Suggestions for future functionality: *
0319bd2004-09-14Henrik Grubbström (Grubba)  * o Pop tail
d3438c2004-09-12Henrik Grubbström (Grubba)  * o Join * o Copy segment * o Detach segment (requires new iterator implementation) * o Iterator copy
0319bd2004-09-14Henrik Grubbström (Grubba)  * o _equal() for iterators and lists. * o _values(), _search(), cast() * o _sizeof()?, _indices()??
d3438c2004-09-12Henrik Grubbström (Grubba)  * o Support for reverse(), filter() and map(). * o Initialization from array.
45e13d2008-06-23Martin Stjernholm  * o Support for Pike.count_memory.
d3438c2004-09-12Henrik Grubbström (Grubba)  */
2687f92013-09-20Per Hedbor  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; }
db628a2004-09-10Henrik Grubbström (Grubba)  INIT { THIS->tail = NULL; THIS->head = TAIL_SENTINEL(THIS); THIS->tail_pred = HEAD_SENTINEL(THIS);
5d32cf2004-09-15Henrik Grubbström (Grubba)  THIS->head_sentinel_refs = THIS->tail_sentinel_refs = 2;
ce2d402004-09-17Henrik Grubbström (Grubba)  THIS->num_elems = 0;
db628a2004-09-10Henrik Grubbström (Grubba)  } EXIT
8dcb7d2008-05-29Martin Stjernholm  gc_trivial;
db628a2004-09-10Henrik Grubbström (Grubba)  {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *node = THIS->head; struct pike_list_node *next;
db628a2004-09-10Henrik Grubbström (Grubba)  while ((next = node->next)) {
cf8d5c2004-09-11Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (node->refs != 2) { Pike_fatal("Unexpected number of references for node: %d\n", node->refs); } #endif /* PIKE_DEBUG */
db628a2004-09-10Henrik Grubbström (Grubba)  unlink_list_node(node); node = next; } }
7468fd2004-09-14Henrik Grubbström (Grubba)  /* These two functions perform the same thing, * but are optimized to minimize recursion. */
4b8ebf2008-03-09Henrik Grubbström (Grubba)  static void gc_check_list_node_backward(struct pike_list_node *node,
7468fd2004-09-14Henrik Grubbström (Grubba)  const char *msg);
4b8ebf2008-03-09Henrik Grubbström (Grubba)  static void gc_check_list_node_forward(struct pike_list_node *node,
7468fd2004-09-14Henrik Grubbström (Grubba)  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; } }
4b8ebf2008-03-09Henrik Grubbström (Grubba)  static void gc_check_list_node_backward(struct pike_list_node *node,
7468fd2004-09-14Henrik Grubbström (Grubba)  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; } }
cf8d5c2004-09-11Henrik Grubbström (Grubba)  /* Called at gc_check time. */ GC_CHECK {
7468fd2004-09-14Henrik Grubbström (Grubba)  gc_check_list_node_backward(HEAD_SENTINEL(THIS), " as a list node");
5d32cf2004-09-15Henrik Grubbström (Grubba)  gc_check_list_node_forward(TAIL_SENTINEL(THIS), " as a list node");
cf8d5c2004-09-11Henrik Grubbström (Grubba)  } /* Called at gc_mark time */ GC_RECURSE {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *node = THIS->head; struct pike_list_node *next;
cf8d5c2004-09-11Henrik Grubbström (Grubba)  while ((next = node->next)) { gc_recurse_svalues(&node->val, 1); node = next; }
45e13d2008-06-23Martin Stjernholm  /* FIXME: mc_count_bytes */
cf8d5c2004-09-11Henrik Grubbström (Grubba)  }
0319bd2004-09-14Henrik Grubbström (Grubba)  /*! @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); }
13a9fc2011-02-16Henrik Grubbström (Grubba)  /*! @decl protected int(0..) _sizeof()
ce2d402004-09-17Henrik Grubbström (Grubba)  *! *! Returns the number of elements in the list. */ PIKEFUN int(0..) _sizeof()
95489a2008-06-29Martin Nilsson  flags ID_PROTECTED;
ce2d402004-09-17Henrik Grubbström (Grubba)  { push_int(THIS->num_elems); }
13a9fc2011-02-16Henrik Grubbström (Grubba)  /*! @decl protected string _sprintf(int c, mapping(string:mixed)|void attr)
2122b62004-10-28Henrik Grubbström (Grubba)  *! *! Describe the list. *! *! @seealso *! @[sprintf()], @[lfun::_sprintf()] */ PIKEFUN string _sprintf(int c, mapping(string:mixed)|void attr)
95489a2008-06-29Martin Nilsson  flags ID_PROTECTED;
2122b62004-10-28Henrik Grubbström (Grubba)  { if (!THIS->num_elems) {
7cf0162014-05-22Per Hedbor  push_text("ADT.List(/* empty */)");
2122b62004-10-28Henrik Grubbström (Grubba)  } else if (c == 'O') {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *node = THIS->head;
2122b62004-10-28Henrik Grubbström (Grubba)  if (THIS->num_elems == 1) {
7cf0162014-05-22Per Hedbor  push_text("ADT.List(/* 1 element */\n");
2122b62004-10-28Henrik Grubbström (Grubba)  } else {
7cf0162014-05-22Per Hedbor  push_text("ADT.List(/* %d elements */\n");
2122b62004-10-28Henrik Grubbström (Grubba)  push_int(THIS->num_elems); f_sprintf(2); } while (node->next) { if (node->next->next) {
7cf0162014-05-22Per Hedbor  push_text(" %O,\n");
2122b62004-10-28Henrik Grubbström (Grubba)  } else {
7cf0162014-05-22Per Hedbor  push_text(" %O\n");
2122b62004-10-28Henrik Grubbström (Grubba)  } push_svalue(&node->val); f_sprintf(2); node = node->next; }
7cf0162014-05-22Per Hedbor  push_text(")");
2122b62004-10-28Henrik Grubbström (Grubba)  f_add(THIS->num_elems + 2); } else { if (THIS->num_elems == 1) {
7cf0162014-05-22Per Hedbor  push_text("ADT.List(/* 1 element */)");
2122b62004-10-28Henrik Grubbström (Grubba)  } else {
7cf0162014-05-22Per Hedbor  push_text("ADT.List(/* %d elements */)");
2122b62004-10-28Henrik Grubbström (Grubba)  push_int(THIS->num_elems); f_sprintf(2); } } stack_pop_n_elems_keep_top(args); }
0319bd2004-09-14Henrik Grubbström (Grubba)  /*! @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
f9af422012-05-09Arne Goedeke  *! @[is_empty()], @[head()], @[pop_back()]
0319bd2004-09-14Henrik Grubbström (Grubba)  */ PIKEFUN mixed tail() {
dcb5ab2012-05-09Arne Goedeke  struct pike_list_node * node = TAIL_SENTINEL(THIS); if (THIS->head->next) { push_svalue(&node->prev->val);
0319bd2004-09-14Henrik Grubbström (Grubba)  } else { Pike_error("Empty list.\n"); } }
f9af422012-05-09Arne Goedeke  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--; }
0319bd2004-09-14Henrik Grubbström (Grubba)  /*! @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
f9af422012-05-09Arne Goedeke  *! @[is_empty()], @[head()], @[tail()], @[pop_back()]
0319bd2004-09-14Henrik Grubbström (Grubba)  */ PIKEFUN mixed pop() { if (THIS->head->next) {
f9af422012-05-09Arne Goedeke  pop_node(THIS->head);
0319bd2004-09-14Henrik Grubbström (Grubba)  } else { Pike_error("Empty list.\n"); } }
f9af422012-05-09Arne Goedeke  /*! @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; } } }
7a74cc2014-08-26Per Hedbor  /*! @decl array cast(string type)
f9af422012-05-09Arne Goedeke  *!
7a74cc2014-08-26Per Hedbor  *! Cast the lists. @expr{array@} is the only *! supported type.
f9af422012-05-09Arne Goedeke  */
7a74cc2014-08-26Per Hedbor  PIKEFUN array cast(string type)
f9af422012-05-09Arne Goedeke  flags ID_PROTECTED; {
68ec3f2014-08-18Martin Nilsson  pop_stack(); /* type as at least one more reference. */ if (type == literal_array_string) apply_current(f_List_cq__values_fun_num, 0); else push_undefined();
f9af422012-05-09Arne Goedeke  } /*! @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); }
db628a2004-09-10Henrik Grubbström (Grubba)  /*! @decl void append(mixed ... values) *! *! Append @[values] to the end of the list. *! *! @seealso *! @[insert()] */ PIKEFUN void append(mixed ... values) {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *node = TAIL_SENTINEL(THIS);
db628a2004-09-10Henrik Grubbström (Grubba)  while (args--) {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *new_node = alloc_pike_list_node();
6699482004-09-28Henrik Grubbström (Grubba)  new_node->val = *(--Pike_sp); prepend_list_node(node, new_node); free_list_node(node = new_node);
ce2d402004-09-17Henrik Grubbström (Grubba)  THIS->num_elems++;
db628a2004-09-10Henrik Grubbström (Grubba)  } push_int(0); } /*! @decl void insert(mixed ... values) *! *! Insert @[values] at the front of the list. *! *! @seealso *! @[append()] */ PIKEFUN void insert(mixed ... values) {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *node = THIS->head;
db628a2004-09-10Henrik Grubbström (Grubba)  while (args--) {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *new_node = alloc_pike_list_node();
6699482004-09-28Henrik Grubbström (Grubba)  new_node->val = *(--Pike_sp); prepend_list_node(node, new_node); free_list_node(node = new_node);
ce2d402004-09-17Henrik Grubbström (Grubba)  THIS->num_elems++;
db628a2004-09-10Henrik Grubbström (Grubba)  } push_int(0); }
f9af422012-05-09Arne Goedeke  /*! @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; } }
13a9fc2011-02-16Henrik Grubbström (Grubba)  /*! @decl protected void create(mixed ... values)
db628a2004-09-10Henrik Grubbström (Grubba)  *! *! Create a new @[List], and initialize it with @[values]. */ PIKEFUN void create(mixed ... values)
95489a2008-06-29Martin Nilsson  flags ID_PROTECTED;
db628a2004-09-10Henrik Grubbström (Grubba)  {
f9af422012-05-09Arne Goedeke  if (THIS->num_elems) apply_current(f_List_flush_fun_num, 0);
db628a2004-09-10Henrik Grubbström (Grubba)  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;
95489a2008-06-29Martin Nilsson  flags ID_PROTECTED;
db628a2004-09-10Henrik Grubbström (Grubba)  {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  CVAR struct pike_list_node *cur;
cf8d5c2004-09-11Henrik Grubbström (Grubba)  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. */
db628a2004-09-10Henrik Grubbström (Grubba) 
ce2d402004-09-17Henrik Grubbström (Grubba)  static struct List_struct *List__get_iterator_find_parent()
db628a2004-09-10Henrik Grubbström (Grubba)  { struct external_variable_context loc; loc.o = Pike_fp->current_object; loc.parent_identifier = Pike_fp->fun;
458d552012-05-10Henrik Grubbström (Grubba)  loc.inherit = Pike_fp->context;
db628a2004-09-10Henrik Grubbström (Grubba)  find_external_context(&loc, 1);
ce2d402004-09-17Henrik Grubbström (Grubba)  return (struct List_struct *)(loc.o->storage + loc.inherit->storage_offset); } INIT { add_ref(THIS->cur = List__get_iterator_find_parent()->head);
db628a2004-09-10Henrik Grubbström (Grubba)  THIS->ind = 0; } EXIT
8dcb7d2008-05-29Martin Stjernholm  gc_trivial;
db628a2004-09-10Henrik Grubbström (Grubba)  { if (THIS->cur) { free_list_node(THIS->cur); THIS->cur = NULL; } }
cf8d5c2004-09-11Henrik Grubbström (Grubba)  /* Called at gc_check time. */ GC_CHECK {
7468fd2004-09-14Henrik Grubbström (Grubba)  gc_check_list_node_forward(THIS->cur, " held by an iterator"); } /* These two functions perform the same thing, * but are optimized to minimize recursion. */
4b8ebf2008-03-09Henrik Grubbström (Grubba)  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)
7468fd2004-09-14Henrik Grubbström (Grubba)  { if (!node || !node->next) return; if (node->next->prev == node) { /* List member. Recursed from the list recurse code. */
cf8d5c2004-09-11Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG
7468fd2004-09-14Henrik Grubbström (Grubba)  if (node->prev->next != node) {
cf8d5c2004-09-11Henrik Grubbström (Grubba)  Pike_fatal("Partially detached node.\n"); } #endif /* PIKE_DEBUG */ return; } #ifdef PIKE_DEBUG
7468fd2004-09-14Henrik Grubbström (Grubba)  if (node->prev->next == node) {
cf8d5c2004-09-11Henrik Grubbström (Grubba)  Pike_fatal("Partially detached node.\n"); } #endif /* PIKE_DEBUG */
7468fd2004-09-14Henrik Grubbström (Grubba)  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 */ } }
4b8ebf2008-03-09Henrik Grubbström (Grubba)  static void gc_recurse_list_node_tree_backward(struct pike_list_node *node, struct pike_list_node *next)
7468fd2004-09-14Henrik Grubbström (Grubba)  { 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 */ } }
cf8d5c2004-09-11Henrik Grubbström (Grubba)  /* 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);
7468fd2004-09-14Henrik Grubbström (Grubba)  gc_recurse_list_node_tree_forward(THIS->cur->next, THIS->cur->prev); gc_recurse_list_node_tree_backward(THIS->cur->next, THIS->cur->prev);
cf8d5c2004-09-11Henrik Grubbström (Grubba)  }
db628a2004-09-10Henrik Grubbström (Grubba)  PIKEFUN int(0..1) `!()
95489a2008-06-29Martin Nilsson  flags ID_PROTECTED;
db628a2004-09-10Henrik Grubbström (Grubba)  { 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() *!
56e48a2008-06-30Henrik Grubbström (Grubba)  *! Reset the iterator to point to the first element in *! the list.
db628a2004-09-10Henrik Grubbström (Grubba)  *! *! @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() {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *next;
db628a2004-09-10Henrik Grubbström (Grubba)  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() {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *prev;
db628a2004-09-10Henrik Grubbström (Grubba)  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) {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *new_node;
db628a2004-09-10Henrik Grubbström (Grubba)  if (!THIS->cur->prev) { Pike_error("Attempt to insert before the start sentinel.\n"); }
4b8ebf2008-03-09Henrik Grubbström (Grubba)  new_node = alloc_pike_list_node();
6699482004-09-28Henrik Grubbström (Grubba)  assign_svalue_no_free(&new_node->val, val); prepend_list_node(THIS->cur, new_node);
db628a2004-09-10Henrik Grubbström (Grubba)  free_list_node(THIS->cur);
6699482004-09-28Henrik Grubbström (Grubba)  THIS->cur = new_node;
ce2d402004-09-17Henrik Grubbström (Grubba)  List__get_iterator_find_parent()->num_elems++;
db628a2004-09-10Henrik Grubbström (Grubba)  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) {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *new_node;
db628a2004-09-10Henrik Grubbström (Grubba)  if (!THIS->cur->next) { Pike_error("Attempt to append after the end sentinel.\n"); }
4b8ebf2008-03-09Henrik Grubbström (Grubba)  new_node = alloc_pike_list_node();
6699482004-09-28Henrik Grubbström (Grubba)  assign_svalue_no_free(&new_node->val, val); append_list_node(THIS->cur, new_node); free_list_node(new_node);
ce2d402004-09-17Henrik Grubbström (Grubba)  List__get_iterator_find_parent()->num_elems++;
db628a2004-09-10Henrik Grubbström (Grubba)  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() {
4b8ebf2008-03-09Henrik Grubbström (Grubba)  struct pike_list_node *next;
db628a2004-09-10Henrik Grubbström (Grubba)  if (!(next = THIS->cur->next) || !THIS->cur->prev) { Pike_error("Attempt to delete a sentinel.\n"); }
cf8d5c2004-09-11Henrik Grubbström (Grubba)  add_ref(next);
ce2d402004-09-17Henrik Grubbström (Grubba)  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--;
cf8d5c2004-09-11Henrik Grubbström (Grubba)  }
db628a2004-09-10Henrik Grubbström (Grubba)  free_list_node(THIS->cur);
cf8d5c2004-09-11Henrik Grubbström (Grubba)  THIS->cur = next;
db628a2004-09-10Henrik Grubbström (Grubba)  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 */
83c38b2004-09-14Henrik Grubbström (Grubba) /*! @endmodule */
fdb7422009-08-19Henrik Grubbström (Grubba) /*! @module Pike */
d8489a2009-08-18Henrik Grubbström (Grubba) /*! @class MasterCodec *!
74bc5f2009-08-19Henrik Grubbström (Grubba)  *! This is a bare-bones codec that is used when loading a dumped master.
d8489a2009-08-18Henrik Grubbström (Grubba)  *! *! @seealso *! @[Codec] */ PIKECLASS MasterCodec flags ID_PROTECTED; {
fdb7422009-08-19Henrik Grubbström (Grubba)  /*! @decl mixed functionof(mixed symbol) *! Look up a function in @[all_constants()].
d8489a2009-08-18Henrik Grubbström (Grubba)  */ PIKEFUN mixed functionof(mixed symbol) { mapping_index_no_free(Pike_sp, get_builtin_constants(), symbol); Pike_sp++; stack_pop_keep_top(); }
74bc5f2009-08-19Henrik Grubbström (Grubba)  /*! @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(); }
63ef652009-08-19Henrik Grubbström (Grubba)  /*! @decl object decode_object(object obj, mixed data)
c8c72a2009-08-20Martin Nilsson  *! Calls @expr{obj->_decode(@[data])@}.
63ef652009-08-19Henrik Grubbström (Grubba)  */ PIKEFUN object decode_object(object obj, mixed data) { apply(obj, "_decode", 1); pop_stack(); }
d8489a2009-08-18Henrik Grubbström (Grubba) }
fdb7422009-08-19Henrik Grubbström (Grubba) /*! @endclass */ /*! @endmodule */
3700122010-11-23Martin Stjernholm static struct object *val_module;
1eb1152009-11-12Henrik Grubbström (Grubba) 
3b54e52014-08-21Martin Nilsson static void get_val_module(void)
1eb1152009-11-12Henrik Grubbström (Grubba) {
3700122010-11-23Martin Stjernholm  assert (!val_module);
7cf0162014-05-22Per Hedbor  push_text ("Val");
3700122010-11-23Martin Stjernholm  APPLY_MASTER ("resolv", 1);
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(Pike_sp[-1]) != T_OBJECT)
3700122010-11-23Martin Stjernholm  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(); \
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(index, T_STRING, 0, string, NULL); \
3700122010-11-23Martin Stjernholm  MAKE_CONST_STRING (index.u.string, TOSTR (NAME)); \ object_index_no_free (&res, val_module, 0, &index); \
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(res) != T_OBJECT) \
3700122010-11-23Martin Stjernholm  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) {
83045c2011-03-05Martin Stjernholm  return Null_program;
1eb1152009-11-12Henrik Grubbström (Grubba) }
7cd6fa2009-11-11Henrik Grubbström (Grubba) 
42d5b32012-01-09Henrik Grubbström (Grubba) PIKECLASS __Backtrace_Tester__ { INIT { Pike_error("__Backtrace_Tester__\n"); } }
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) void init_builtin(void) {
b6a9792013-06-26Henrik Grubbström (Grubba)  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);
c48ab32014-08-10Martin Nilsson  INIT;
3a5b1d2000-05-24Fredrik Hübinette (Hubbe) }
8650752001-06-25Henrik Grubbström (Grubba)  void exit_builtin(void) {
b6a9792013-06-26Henrik Grubbström (Grubba)  struct svalue zero;
3700122010-11-23Martin Stjernholm  if (val_module) free_object (val_module);
c48ab32014-08-10Martin Nilsson  EXIT;
b6a9792013-06-26Henrik Grubbström (Grubba)  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);
c1f4762008-11-02Henrik Grubbström (Grubba) #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. */
d476592013-06-12Arne Goedeke  ba_destroy(&pike_list_node_allocator);
c1f4762008-11-02Henrik Grubbström (Grubba) #endif
687af42008-07-08Henrik Grubbström (Grubba) #ifndef USE_SETENV
8d401b2008-06-05Martin Stjernholm  if (env_allocs) free_mapping (env_allocs);
687af42008-07-08Henrik Grubbström (Grubba) #endif
e950862014-08-29Stephen R. van den Berg  if( shm_program ) free_program( shm_program );
8650752001-06-25Henrik Grubbström (Grubba) }