cb22561995-10-11Fredrik Hübinette (Hubbe) /*\
06983f1996-09-22Fredrik Hübinette (Hubbe) ||| This file a part of Pike, and is copyright by Fredrik Hubinette ||| Pike is distributed as GPL (General Public License)
cb22561995-10-11Fredrik Hübinette (Hubbe) ||| See the files COPYING and DISCLAIMER for more information. \*/
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "global.h"
4c3d391999-01-15Fredrik Hübinette (Hubbe) RCSID("$Id: builtin_functions.c,v 1.143 1999/01/16 01:20:39 hubbe Exp $");
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "interpret.h" #include "svalue.h"
bb55f81997-03-16Fredrik Hübinette (Hubbe) #include "pike_macros.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "object.h" #include "program.h" #include "array.h" #include "error.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "constants.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "mapping.h" #include "stralloc.h" #include "lex.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "multiset.h" #include "pike_types.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "rusage.h" #include "operators.h" #include "fsort.h" #include "callback.h"
624d091996-02-24Fredrik Hübinette (Hubbe) #include "gc.h"
ed70b71996-06-09Fredrik Hübinette (Hubbe) #include "backend.h" #include "main.h"
9aa6fa1997-05-19Fredrik Hübinette (Hubbe) #include "pike_memory.h"
07513e1996-10-04Fredrik Hübinette (Hubbe) #include "threads.h"
3beb891996-06-21Fredrik Hübinette (Hubbe) #include "time_stuff.h"
6023ae1997-01-18Fredrik Hübinette (Hubbe) #include "version.h"
aac0151997-01-26Fredrik Hübinette (Hubbe) #include "encode.h"
3beb891996-06-21Fredrik Hübinette (Hubbe) #include <math.h>
38bddc1996-08-12Fredrik Hübinette (Hubbe) #include <ctype.h>
32a9581997-01-31Fredrik Hübinette (Hubbe) #include "module_support.h"
9c6f7d1997-04-15Fredrik Hübinette (Hubbe) #include "module.h" #include "opcodes.h"
fc33451997-10-02Fredrik Hübinette (Hubbe) #include "cyclic.h"
89b0721998-05-05Fredrik Hübinette (Hubbe) #include "signal_handler.h"
4c3d391999-01-15Fredrik Hübinette (Hubbe) #include "security.h"
6930181996-02-25Fredrik Hübinette (Hubbe) 
8bee431998-04-01Henrik Grubbström (Grubba) #ifdef HAVE_POLL
df284f1998-04-29Henrik Grubbström (Grubba) #ifdef HAVE_POLL_H
8bee431998-04-01Henrik Grubbström (Grubba) #include <poll.h>
df284f1998-04-29Henrik Grubbström (Grubba) #endif /* HAVE_POLL_H */ #ifdef HAVE_SYS_POLL_H #include <sys/poll.h> #endif /* HAVE_SYS_POLL_H */
8bee431998-04-01Henrik Grubbström (Grubba) #endif /* HAVE_POLL */
5267b71995-08-09Fredrik Hübinette (Hubbe) #ifdef HAVE_CRYPT_H #include <crypt.h> #endif
8fe8101998-03-16Henrik Grubbström (Grubba) /* #define DIFF_DEBUG */
92bb061998-05-19Henrik Grubbström (Grubba) /* #define ENABLE_DYN_DIFF */
38bddc1996-08-12Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_equal(INT32 args) { int i;
7cc8311998-04-10Henrik Grubbström (Grubba)  if(args != 2)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("equal", "Bad number of arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  i=is_equal(sp-2,sp-1); pop_n_elems(args); push_int(i); } void f_aggregate(INT32 args) { struct array *a;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
c72a4e1998-12-15Fredrik Hübinette (Hubbe)  if(args < 0) fatal("Negative args to f_aggregate() (%d)\n",args);
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif
99946c1996-02-17Fredrik Hübinette (Hubbe)  a=aggregate_array(args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  push_array(a); /* beware, macro */ } void f_trace(INT32 args) { extern int t_flag;
32a9581997-01-31Fredrik Hübinette (Hubbe)  int old_t_flag=t_flag; get_all_args("trace",args,"%i",&t_flag); pop_n_elems(args); push_int(old_t_flag);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_hash(INT32 args) { INT32 i; if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("hash", "Too few arguments.\n", sp, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("hash", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  i=hashstr((unsigned char *)sp[-args].u.string->str,100);
1b77121998-03-20Per Hedbor 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args > 1) { if(sp[1-args].type != T_INT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("hash", "Bad argument 2.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!sp[1-args].u.integer)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("hash", "Modulo by zero.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  i%=(unsigned INT32)sp[1-args].u.integer; } pop_n_elems(args); push_int(i); } void f_copy_value(INT32 args) { if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("copy_value", "Too few arguments.\n", sp, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); copy_svalues_recursively_no_free(sp,sp-1,1,0); free_svalue(sp-1); sp[-1]=sp[0]; } void f_ctime(INT32 args) {
a868471998-01-29Henrik Grubbström (Grubba)  time_t i;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("ctime", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_INT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("ctime", "Bad argument 1.\n", sp, args);
a868471998-01-29Henrik Grubbström (Grubba)  i=(time_t)sp[-args].u.integer;
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args);
a868471998-01-29Henrik Grubbström (Grubba)  push_string(make_shared_string(ctime(&i)));
5267b71995-08-09Fredrik Hübinette (Hubbe) }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) /* FIXME: wide char support ! */
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_lower_case(INT32 args) { INT32 i;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *ret;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("lower_case", "Too few arguments.\n", sp, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("lower_case", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  ret=begin_shared_string(sp[-args].u.string->len); MEMCPY(ret->str, sp[-args].u.string->str,sp[-args].u.string->len); for (i = sp[-args].u.string->len-1; i>=0; i--)
13cc841996-11-01Fredrik Hübinette (Hubbe)  if (isupper(EXTRACT_UCHAR( ret->str + i))) ret->str[i] = tolower(EXTRACT_UCHAR(ret->str+i));
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(end_shared_string(ret)); }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) /* FIXME: wide char support ! */
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_upper_case(INT32 args) { INT32 i;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *ret;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("upper_case", "Too few arguments.\n", sp, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("upper_case", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  ret=begin_shared_string(sp[-args].u.string->len); MEMCPY(ret->str, sp[-args].u.string->str,sp[-args].u.string->len); for (i = sp[-args].u.string->len-1; i>=0; i--)
13cc841996-11-01Fredrik Hübinette (Hubbe)  if (islower(EXTRACT_UCHAR(ret->str+i))) ret->str[i] = toupper(EXTRACT_UCHAR(ret->str+i));
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(end_shared_string(ret)); } void f_random(INT32 args) { if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("random", "Too few arguments.\n", sp, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_INT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("random", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].u.integer <= 0) { sp[-args].u.integer = 0; }else{ sp[-args].u.integer = my_rand() % sp[-args].u.integer; } pop_n_elems(args-1); }
cb22561995-10-11Fredrik Hübinette (Hubbe) void f_random_seed(INT32 args) { if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("random_seed", "Too few arguments.\n", sp, 0);
cb22561995-10-11Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_INT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("random_seed", "Bad argument 1.\n", sp, args);
cb22561995-10-11Fredrik Hübinette (Hubbe)  my_srand(sp[-args].u.integer);
f6f02d1995-10-16Fredrik Hübinette (Hubbe)  pop_n_elems(args);
cb22561995-10-11Fredrik Hübinette (Hubbe) }
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_query_num_arg(INT32 args) { pop_n_elems(args);
cb22561995-10-11Fredrik Hübinette (Hubbe)  push_int(fp ? fp->args : 0);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_search(INT32 args) { INT32 start; if(args < 2)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("search", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  switch(sp[-args].type) { case T_STRING: { char *ptr; if(sp[1-args].type != T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("search", "Bad argument 2.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  start=0; if(args > 2) { if(sp[2-args].type!=T_INT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("search", "Bad argument 3.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  start=sp[2-args].u.integer;
84f4f91998-02-27Fredrik Hübinette (Hubbe)  if(start<0)
43bf151998-10-14Henrik Grubbström (Grubba)  PIKE_ERROR("search", "Start must be greater or equal to zero.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
43bf151998-10-14Henrik Grubbström (Grubba)  if(sp[-args].u.string->len < start) PIKE_ERROR("search", "Start must not be greater than the length of the string.\n", sp, args);
84f4f91998-02-27Fredrik Hübinette (Hubbe) 
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  start=string_search(sp[-args].u.string, sp[1-args].u.string, start);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(start); break; } case T_ARRAY: start=0; if(args > 2) { if(sp[2-args].type!=T_INT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("search", "Bad argument 3.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  start=sp[2-args].u.integer; } start=array_search(sp[-args].u.array,sp+1-args,start); pop_n_elems(args); push_int(start); break; case T_MAPPING: if(args > 2) mapping_search_no_free(sp,sp[-args].u.mapping,sp+1-args,sp+2-args); else mapping_search_no_free(sp,sp[-args].u.mapping,sp+1-args,0); free_svalue(sp-args); sp[-args]=*sp; pop_n_elems(args-1); return; default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("search", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } void f_backtrace(INT32 args) { INT32 frames;
0bd5a41997-03-10Fredrik Hübinette (Hubbe)  struct frame *f,*of;
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct array *a,*i; frames=0; if(args) pop_n_elems(args); for(f=fp;f;f=f->parent_frame) frames++; sp->type=T_ARRAY;
99946c1996-02-17Fredrik Hübinette (Hubbe)  sp->u.array=a=allocate_array_no_init(frames,0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp++;
7cc8311998-04-10Henrik Grubbström (Grubba)  /* NOTE: The first frame is ignored, since it is the call to backtrace(). */
0bd5a41997-03-10Fredrik Hübinette (Hubbe)  of=0; for(f=fp;f;f=(of=f)->parent_frame)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { char *program_name; frames--;
c647321997-10-21Fredrik Hübinette (Hubbe)  if(f->current_object && f->context.prog)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
0bd5a41997-03-10Fredrik Hübinette (Hubbe)  INT32 args; args=f->num_args; args=MINIMUM(f->num_args, sp - f->locals); if(of) args=MINIMUM(f->num_args, of->locals - f->locals); args=MAXIMUM(args,0); ITEM(a)[frames].u.array=i=allocate_array_no_init(3+args,0);
99946c1996-02-17Fredrik Hübinette (Hubbe)  ITEM(a)[frames].type=T_ARRAY;
bb55f81997-03-16Fredrik Hübinette (Hubbe)  assign_svalues_no_free(ITEM(i)+3, f->locals, args, BIT_MIXED);
c647321997-10-21Fredrik Hübinette (Hubbe)  if(f->current_object->prog) { ITEM(i)[2].type=T_FUNCTION; ITEM(i)[2].subtype=f->fun; ITEM(i)[2].u.object=f->current_object;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(f->current_object);
c647321997-10-21Fredrik Hübinette (Hubbe)  }else{ ITEM(i)[2].type=T_INT; ITEM(i)[2].subtype=NUMBER_DESTRUCTED; ITEM(i)[2].u.integer=0; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(f->pc) { program_name=get_line(f->pc, f->context.prog, & ITEM(i)[1].u.integer); ITEM(i)[1].subtype=NUMBER_NUMBER; ITEM(i)[1].type=T_INT; ITEM(i)[0].u.string=make_shared_string(program_name); #ifdef __CHECKER__ ITEM(i)[0].subtype=0; #endif ITEM(i)[0].type=T_STRING; }else{ ITEM(i)[1].u.integer=0; ITEM(i)[1].subtype=NUMBER_NUMBER; ITEM(i)[1].type=T_INT; ITEM(i)[0].u.integer=0; ITEM(i)[0].subtype=NUMBER_NUMBER; ITEM(i)[0].type=T_INT; } }else{
99946c1996-02-17Fredrik Hübinette (Hubbe)  ITEM(a)[frames].type=T_INT; ITEM(a)[frames].u.integer=0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
c5d9811996-05-16Fredrik Hübinette (Hubbe)  a->type_field = BIT_ARRAY | BIT_INT;
5267b71995-08-09Fredrik Hübinette (Hubbe) }
06983f1996-09-22Fredrik Hübinette (Hubbe) void f_add_constant(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("add_constant: permission denied.\n"));
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args<1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("add_constant", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type!=T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("add_constant", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args>1) { low_add_efun(sp[-args].u.string, sp-args+1); }else{ low_add_efun(sp[-args].u.string, 0); } pop_n_elems(args); }
dc7cc91998-01-14Fredrik Hübinette (Hubbe) #ifndef __NT__ #define IS_SEP(X) ( (X)=='/' ) #define IS_ABS(X) (IS_SEP((X)[0])?1:0) #else #define IS_SEP(X) ( (X) == '/' || (X) == '\\' )
5a7ab61998-01-31Fredrik Hübinette (Hubbe) #define IS_ABS(X) ((isalpha((X)[0]) && (X)[1]==':' && IS_SEP((X)[2]))?3:0) #define IS_ROOT(X) (IS_SEP((X)[0])?1:0)
dc7cc91998-01-14Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) static char *combine_path(char *cwd,char *file) { /* cwd is supposed to be combined already */ char *ret; register char *from,*to; char *my_cwd;
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  char cwdbuf[10];
5267b71995-08-09Fredrik Hübinette (Hubbe)  my_cwd=0;
905bb11998-01-31Fredrik Hübinette (Hubbe)  if(IS_ABS(file))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  MEMCPY(cwdbuf,file,IS_ABS(file)); cwdbuf[IS_ABS(file)]=0; cwd=cwdbuf; file+=IS_ABS(file);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
5a7ab61998-01-31Fredrik Hübinette (Hubbe)  #ifdef IS_ROOT
905bb11998-01-31Fredrik Hübinette (Hubbe)  else if(IS_ROOT(file))
5a7ab61998-01-31Fredrik Hübinette (Hubbe)  {
905bb11998-01-31Fredrik Hübinette (Hubbe)  if(IS_ABS(cwd)) { MEMCPY(cwdbuf,cwd,IS_ABS(cwd)); cwdbuf[IS_ABS(cwd)]=0; cwd=cwdbuf; file+=IS_ROOT(file); }else{ MEMCPY(cwdbuf,file,IS_ROOT(file)); cwdbuf[IS_ROOT(file)]=0; cwd=cwdbuf; file+=IS_ROOT(file); }
5a7ab61998-01-31Fredrik Hübinette (Hubbe)  } #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
779b2c1995-11-20Fredrik Hübinette (Hubbe)  if(!cwd) fatal("No cwd in combine_path!\n"); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) 
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(!*cwd || IS_SEP(cwd[strlen(cwd)-1]))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { ret=(char *)xalloc(strlen(cwd)+strlen(file)+1); strcpy(ret,cwd); strcat(ret,file); }else{ ret=(char *)xalloc(strlen(cwd)+strlen(file)+2); strcpy(ret,cwd); strcat(ret,"/"); strcat(ret,file); } from=to=ret;
b603cd1997-08-26Fredrik Hübinette (Hubbe)  /* Skip all leading "./" */
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  while(from[0]=='.' && IS_SEP(from[1])) from+=2;
5267b71995-08-09Fredrik Hübinette (Hubbe)  while(( *to = *from )) {
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(IS_SEP(*from))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
9674d41997-11-13Fredrik Hübinette (Hubbe)  while(to>ret && to[-1]=='/') to--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(from[1] == '.') { switch(from[2]) { case '.':
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(IS_SEP(from[3]) || !from[3])
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
b603cd1997-08-26Fredrik Hübinette (Hubbe)  char *tmp=to; while(--tmp>=ret)
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(IS_SEP(*tmp))
b603cd1997-08-26Fredrik Hübinette (Hubbe)  break;
9674d41997-11-13Fredrik Hübinette (Hubbe)  tmp++;
b603cd1997-08-26Fredrik Hübinette (Hubbe) 
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(tmp[0]=='.' && tmp[1]=='.' && (IS_SEP(tmp[2]) || !tmp[2]))
b603cd1997-08-26Fredrik Hübinette (Hubbe)  break;
5267b71995-08-09Fredrik Hübinette (Hubbe)  from+=3;
b603cd1997-08-26Fredrik Hübinette (Hubbe)  to=tmp;
5267b71995-08-09Fredrik Hübinette (Hubbe)  continue; } break; case 0:
44c89f1997-08-27Henrik Grubbström (Grubba)  case '/':
dc7cc91998-01-14Fredrik Hübinette (Hubbe) #ifdef __NT__ case '\\': #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  from+=2; continue; } } } from++; to++; }
9674d41997-11-13Fredrik Hübinette (Hubbe) 
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(*ret && !IS_SEP(from[-1]) && IS_SEP(to[-1]))
2b5d7f1997-11-16Fredrik Hübinette (Hubbe)  *--to=0;
9674d41997-11-13Fredrik Hübinette (Hubbe) 
b603cd1997-08-26Fredrik Hübinette (Hubbe)  if(!*ret) {
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  if(IS_SEP(*cwd))
b603cd1997-08-26Fredrik Hübinette (Hubbe)  { ret[0]='/'; ret[1]=0; }else{ ret[0]='.'; ret[1]=0; } }
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(my_cwd) free(my_cwd); return ret; } void f_combine_path(INT32 args) {
05459a1998-04-09Fredrik Hübinette (Hubbe)  char *path=0; int e,dofree=0; struct pike_string *ret; if(args<1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("combine_path", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("combine_path", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
05459a1998-04-09Fredrik Hübinette (Hubbe)  path=sp[-args].u.string->str;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
05459a1998-04-09Fredrik Hübinette (Hubbe)  for(e=1;e<args;e++) { char *newpath; if(sp[e-args].type != T_STRING) { if(dofree) free(path); error("Bad argument %d to combine_path.\n",e); }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
05459a1998-04-09Fredrik Hübinette (Hubbe)  newpath=combine_path(path,sp[e-args].u.string->str); if(dofree) free(path); path=newpath; dofree=1; } ret=make_shared_string(path); if(dofree) free(path); pop_n_elems(args); push_string(ret);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_function_object(INT32 args) { if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("function_object", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_FUNCTION)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("function_object", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
bdb5091996-09-25Fredrik Hübinette (Hubbe)  if(sp[-args].subtype == FUNCTION_BUILTIN)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0); }else{ pop_n_elems(args-1); sp[-1].type=T_OBJECT; } } void f_function_name(INT32 args) {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("function_name", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_FUNCTION)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("function_name", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
bdb5091996-09-25Fredrik Hübinette (Hubbe)  if(sp[-args].subtype == FUNCTION_BUILTIN)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0); }else{ if(!sp[-args].u.object->prog)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("function_name", "Destructed object.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  copy_shared_string(s,ID_FROM_INT(sp[-args].u.object->prog, sp[-args].subtype)->name); pop_n_elems(args); sp->type=T_STRING; sp->u.string=s; sp++; } } void f_zero_type(INT32 args) { if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("zero_type", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_INT)
3f6d8f1996-11-26Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  } else if((sp[-args].type==T_OBJECT || sp[-args].type==T_FUNCTION) && !sp[-args].u.object->prog) { pop_n_elems(args); push_int(NUMBER_DESTRUCTED); } {
3f6d8f1996-11-26Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); sp[-1].u.integer=sp[-1].subtype; sp[-1].subtype=NUMBER_NUMBER; }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
4643ea1998-10-10Henrik Grubbström (Grubba) /* * Some wide-strings related functions */ void f_string_to_unicode(INT32 args) { struct pike_string *in; struct pike_string *out = NULL; INT32 len; int i;
1d8bb01998-10-10Henrik Grubbström (Grubba)  get_all_args("string_to_unicode", args, "%W", &in);
4643ea1998-10-10Henrik Grubbström (Grubba)  switch(in->size_shift) { case 0: /* Just 8bit characters */ len = in->len * 2; out = begin_shared_string(len); MEMSET(out->str, 0, len); /* Clear the upper (and lower) byte */ for(i = in->len; i--;) {
66ded01998-10-15Henrik Grubbström (Grubba)  out->str[i * 2 + 1] = in->str[i];
4643ea1998-10-10Henrik Grubbström (Grubba)  } out = end_shared_string(out); break; case 1: /* 16 bit characters */ /* FIXME: Should we check for 0xfffe & 0xffff here too? */ len = in->len * 2; out = begin_shared_string(len);
71f3a21998-11-22Fredrik Hübinette (Hubbe) #if (PIKE_BYTEORDER == 4321)
4643ea1998-10-10Henrik Grubbström (Grubba)  /* Big endian -- We don't need to do much... * * FIXME: Future optimization: Check if refcount is == 1, * and perform sufficient magic to be able to convert in place. */ MEMCPY(out->str, in->str, len); #else /* Other endianness, may need to do byte-order conversion also. */ { p_wchar1 *str1 = STR1(in); for(i = in->len; i--;) { unsigned INT32 c = str1[i];
7156611998-10-15Henrik Grubbström (Grubba)  out->str[i * 2 + 1] = c & 0xff;
66b11d1998-10-15Henrik Grubbström (Grubba)  out->str[i * 2] = c >> 8;
4643ea1998-10-10Henrik Grubbström (Grubba)  } } #endif out = end_shared_string(out); break; case 2: /* 32 bit characters -- Is someone writing in Klingon? */ { p_wchar2 *str2 = STR2(in);
01c1081998-10-10Henrik Grubbström (Grubba)  int j; len = in->len * 2;
4643ea1998-10-10Henrik Grubbström (Grubba)  /* Check how many extra wide characters there are. */ for(i = in->len; i--;) { if (str2[i] > 0xfffd) { if (str2[i] < 0x10000) { /* 0xfffe: Byte-order detection illegal character. * 0xffff: Illegal character. */ error("string_to_unicode(): Illegal character 0x%04x (index %d) " "is not a Unicode character.", str2[i], i); } if (str2[i] > 0x10ffff) { error("string_to_unicode(): Character 0x%08x (index %d) " "is out of range (0x00000000 - 0x0010ffff).", str2[i], i); } /* Extra wide characters take two unicode characters in space. * ie One unicode character extra. */ len += 2; } } out = begin_shared_string(len);
01c1081998-10-10Henrik Grubbström (Grubba)  j = len;
4643ea1998-10-10Henrik Grubbström (Grubba)  for(i = in->len; i--;) { unsigned INT32 c = str2[i]; j -= 2; if (c > 0xffff) { /* Use surrogates */ c -= 0x10000; out->str[j + 1] = c & 0xff; out->str[j] = 0xdc | ((c >> 8) & 0x03); j -= 2; c >>= 10; c |= 0xd800; } out->str[j + 1] = c & 0xff; out->str[j] = c >> 8; }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
4643ea1998-10-10Henrik Grubbström (Grubba)  if (j) { fatal("string_to_unicode(): Indexing error: len:%d, j:%d.\n", len, j); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
4643ea1998-10-10Henrik Grubbström (Grubba)  out = end_shared_string(out); } break; default: error("string_to_unicode(): Bad string shift: %d!\n", in->size_shift); break; } pop_n_elems(args); push_string(out); } void f_unicode_to_string(INT32 args) { struct pike_string *in; struct pike_string *out = NULL; INT32 len; get_all_args("unicode_to_string", args, "%S", &in); if (in->len & 1) { error("unicode_to_string(): String length is odd.\n"); } /* FIXME: In the future add support for decoding of surrogates. */ len = in->len / 2;
1e45331998-10-10Henrik Grubbström (Grubba)  out = begin_wide_shared_string(len, 1);
71f3a21998-11-22Fredrik Hübinette (Hubbe) #if (PIKE_BYTEORDER == 4321)
4643ea1998-10-10Henrik Grubbström (Grubba)  /* Big endian * * FIXME: Future optimization: Perform sufficient magic * to do the conversion in place if the ref-count is == 1. */
1e45331998-10-10Henrik Grubbström (Grubba)  MEMCPY(out->str, in->str, in->len);
4643ea1998-10-10Henrik Grubbström (Grubba) #else /* Little endian */ { int i; p_wchar1 *str1 = STR1(out); for (i = len; i--;) {
66b11d1998-10-15Henrik Grubbström (Grubba)  str1[i] = (((unsigned char *)in->str)[i*2]<<8) + ((unsigned char *)in->str)[i*2 + 1];
4643ea1998-10-10Henrik Grubbström (Grubba)  } }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_BYTEORDER == 4321 */
4643ea1998-10-10Henrik Grubbström (Grubba)  out = end_shared_string(out); pop_n_elems(args); push_string(out); }
be40771998-10-15Henrik Grubbström (Grubba) void f_string_to_utf8(INT32 args) { int len; struct pike_string *in; struct pike_string *out; int i,j; int extended = 0; get_all_args("string_to_utf8", args, "%W", &in); if (args > 1) { if (sp[1-args].type != T_INT) { error("string_to_utf8(): Bad argument 2, expected int|void.\n"); } extended = sp[1-args].u.integer; } len = in->len; for(i=0; i < in->len; i++) { unsigned INT32 c = index_shared_string(in, i); if (c & ~0x7f) { /* 8bit or more. */ len++; if (c & ~0x7ff) { /* 12bit or more. */ len++; if (c & ~0xffff) { /* 17bit or more. */ len++; if (c & ~0x1fffff) { /* 22bit or more. */ len++; if (c & ~0x3ffffff) { /* 27bit or more. */ len++; if (c & ~0x7fffffff) { /* 32bit or more. */
cf03f91998-10-31Henrik Grubbström (Grubba)  if (!extended) { error("string_to_utf8(): " "Value 0x%08x (index %d) is larger than 31 bits.\n", c, i); }
be40771998-10-15Henrik Grubbström (Grubba)  len++; /* FIXME: Needs fixing when we get 64bit chars... */ } } } } } } } if (len == in->len) {
8e3f351998-10-23Henrik Grubbström (Grubba)  /* 7bit string -- already valid utf8. */
be40771998-10-15Henrik Grubbström (Grubba)  pop_n_elems(args - 1); return; } out = begin_shared_string(len); for(i=j=0; i < in->len; i++) { unsigned INT32 c = index_shared_string(in, i); if (!(c & ~0x7f)) { /* 7bit */ out->str[j++] = c; } else if (!(c & ~0x7ff)) { /* 11bit */ out->str[j++] = 0xc0 | (c >> 6); out->str[j++] = 0x80 | (c & 0x3f); } else if (!(c & ~0xffff)) { /* 16bit */ out->str[j++] = 0xe0 | (c >> 12); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } else if (!(c & ~0x1fffff)) { /* 21bit */ out->str[j++] = 0xf0 | (c >> 18); out->str[j++] = 0x80 | ((c >> 12) & 0x3f); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } else if (!(c & ~0x3ffffff)) { /* 26bit */ out->str[j++] = 0xf8 | (c >> 24); out->str[j++] = 0x80 | ((c >> 18) & 0x3f); out->str[j++] = 0x80 | ((c >> 12) & 0x3f); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } else if (!(c & ~0x7fffffff)) { /* 31bit */ out->str[j++] = 0xfc | (c >> 30); out->str[j++] = 0x80 | ((c >> 24) & 0x3f); out->str[j++] = 0x80 | ((c >> 18) & 0x3f); out->str[j++] = 0x80 | ((c >> 12) & 0x3f); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } else {
ed65901998-10-31Henrik Grubbström (Grubba)  /* This and onwards is extended UTF-8 encoding. */
be40771998-10-15Henrik Grubbström (Grubba)  /* 32 - 36bit */ out->str[j++] = 0xfe; out->str[j++] = 0x80 | ((c >> 30) & 0x3f); out->str[j++] = 0x80 | ((c >> 24) & 0x3f); out->str[j++] = 0x80 | ((c >> 18) & 0x3f); out->str[j++] = 0x80 | ((c >> 12) & 0x3f); out->str[j++] = 0x80 | ((c >> 6) & 0x3f); out->str[j++] = 0x80 | (c & 0x3f); } }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
be40771998-10-15Henrik Grubbström (Grubba)  if (len != j) { fatal("string_to_utf8(): Calculated and actual lengths differ: %d != %d\n", len, j); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
be40771998-10-15Henrik Grubbström (Grubba)  out = end_shared_string(out); pop_n_elems(args); push_string(out); } void f_utf8_to_string(INT32 args) { struct pike_string *in; struct pike_string *out; int len = 0; int shift = 0; int i,j;
ed65901998-10-31Henrik Grubbström (Grubba)  int extended = 0;
be40771998-10-15Henrik Grubbström (Grubba)  get_all_args("utf8_to_string", args, "%S", &in);
ed65901998-10-31Henrik Grubbström (Grubba)  if (args > 1) { if (sp[1-args].type != T_INT) { error("utf8_to_string(): Bad argument 2, expected int|void.\n"); } extended = sp[1-args].u.integer; }
be40771998-10-15Henrik Grubbström (Grubba)  for(i=0; i < in->len; i++) { unsigned int c = ((unsigned char *)in->str)[i]; len++; if (c & 0x80) { int cont = 0; if ((c & 0xc0) == 0x80) { error("utf8_to_string(): " "Unexpected continuation block 0x%02x at index %d.\n", c, i); } if ((c & 0xe0) == 0xc0) { /* 11bit */ cont = 1; if (c & 0x1c) { if (shift < 1) { shift = 1; } } } else if ((c & 0xf0) == 0xe0) { /* 16bit */ cont = 2; if (shift < 1) { shift = 1; } } else { shift = 2; if ((c & 0xf8) == 0xf0) { /* 21bit */ cont = 3; } else if ((c & 0xfc) == 0xf8) { /* 26bit */ cont = 4; } else if ((c & 0xfe) == 0xfc) { /* 31bit */ cont = 5; } else if (c == 0xfe) { /* 36bit */
ed65901998-10-31Henrik Grubbström (Grubba)  if (!extended) { error("utf8_to_string(): " "Character 0xfe at index %d when not in extended mode.\n", i); }
be40771998-10-15Henrik Grubbström (Grubba)  cont = 6; } else { error("utf8_to_string(): " "Unexpected character 0xff at index %d.\n", i); } } while(cont--) { i++; if (i >= in->len) { error("utf8_to_string(): Truncated UTF8 sequence.\n"); } c = ((unsigned char *)(in->str))[i]; if ((c & 0xc0) != 0x80) { error("utf8_to_string(): " "Expected continuation character at index %d (got 0x%02x).\n", i, c); } } } } if (len == in->len) { /* 7bit in == 7bit out */ pop_n_elems(args-1); return; } out = begin_wide_shared_string(len, shift); for(j=i=0; i < in->len; i++) { unsigned int c = ((unsigned char *)in->str)[i]; if (c & 0x80) { int cont = 0; /* NOTE: The tests aren't as paranoid here, since we've * already tested the string above. */ if ((c & 0xe0) == 0xc0) { /* 11bit */ cont = 1; c &= 0x1f; } else if ((c & 0xf0) == 0xe0) { /* 16bit */ cont = 2; c &= 0x0f; } else if ((c & 0xf8) == 0xf0) { /* 21bit */ cont = 3; c &= 0x07; } else if ((c & 0xfc) == 0xf8) { /* 26bit */ cont = 4; c &= 0x03; } else if ((c & 0xfe) == 0xfc) { /* 31bit */ cont = 5; c &= 0x01; } else { /* 36bit */ cont = 6; c = 0; } while(cont--) { unsigned INT32 c2 = ((unsigned char *)(in->str))[++i] & 0x3f; c = (c << 6) | c2; } } low_set_index(out, j++, c); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
be40771998-10-15Henrik Grubbström (Grubba)  if (j != len) { fatal("utf8_to_string(): Calculated and actual lengths differ: %d != %d\n", len, j); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
be40771998-10-15Henrik Grubbström (Grubba)  out = end_shared_string(out); pop_n_elems(args); push_string(out); }
06983f1996-09-22Fredrik Hübinette (Hubbe) void f_all_constants(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { pop_n_elems(args);
0e88611998-04-16Fredrik Hübinette (Hubbe)  ref_push_mapping(get_builtin_constants());
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_allocate(INT32 args) { INT32 size;
8267f41998-01-28Fredrik Hübinette (Hubbe)  struct array *a;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("allocate", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type!=T_INT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("allocate", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  size=sp[-args].u.integer; if(size < 0)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("allocate", "Can't allocate array of negative size.\n", sp, args);
8267f41998-01-28Fredrik Hübinette (Hubbe)  a=allocate_array(size); if(args>1) { INT32 e; for(e=0;e<a->size;e++) copy_svalues_recursively_no_free(a->item+e, sp-args+1, 1, 0); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args);
8267f41998-01-28Fredrik Hübinette (Hubbe)  push_array(a);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_rusage(INT32 args) {
99946c1996-02-17Fredrik Hübinette (Hubbe)  INT32 *rus,e;
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct array *v; pop_n_elems(args); rus=low_rusage(); if(!rus)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("rusage", "System rusage information not available.\n", sp, args);
99946c1996-02-17Fredrik Hübinette (Hubbe)  v=allocate_array_no_init(29,0); for(e=0;e<29;e++) { ITEM(v)[e].type=T_INT; ITEM(v)[e].subtype=NUMBER_NUMBER; ITEM(v)[e].u.integer=rus[e]; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp->u.array=v; sp->type=T_ARRAY; sp++; } void f_this_object(INT32 args) { pop_n_elems(args);
cb22561995-10-11Fredrik Hübinette (Hubbe)  if(fp) { sp->u.object=fp->current_object; sp->type=T_OBJECT;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(fp->current_object);
cb22561995-10-11Fredrik Hübinette (Hubbe)  sp++; }else{ push_int(0); }
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_throw(INT32 args) { if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("throw", "Too few arguments.\n", sp, args);
864d3c1998-01-29Fredrik Hübinette (Hubbe)  assign_svalue(&throw_value,sp-args); pop_n_elems(args);
641d5c1998-04-09Fredrik Hübinette (Hubbe)  throw_severity=0;
dc7cc91998-01-14Fredrik Hübinette (Hubbe)  pike_throw();
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_exit(INT32 args) {
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("exit: permission denied.\n"));
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("exit", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_INT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("exit", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
61e9a01998-01-25Fredrik Hübinette (Hubbe)  assign_svalue(&throw_value, sp-args); throw_severity=THROW_EXIT; pike_throw();
5267b71995-08-09Fredrik Hübinette (Hubbe) }
608d731998-03-20Fredrik Hübinette (Hubbe) void f__exit(INT32 args) {
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("_exit: permission denied.\n"));
608d731998-03-20Fredrik Hübinette (Hubbe)  if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("_exit", "Too few arguments.\n", sp, args);
608d731998-03-20Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_INT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("_exit", "Bad argument 1.\n", sp, args);
608d731998-03-20Fredrik Hübinette (Hubbe) 
cf03f91998-10-31Henrik Grubbström (Grubba)  exit(sp[-args].u.integer);
608d731998-03-20Fredrik Hübinette (Hubbe) }
5267b71995-08-09Fredrik Hübinette (Hubbe) void f_time(INT32 args) {
7b52a01998-03-10Henrik Grubbström (Grubba)  if(!args)
d0e6741998-07-15Fredrik Hübinette (Hubbe)  {
7b52a01998-03-10Henrik Grubbström (Grubba)  GETTIMEOFDAY(&current_time);
d0e6741998-07-15Fredrik Hübinette (Hubbe)  }else{ if(sp[-args].type == T_INT && sp[-args].u.integer > 1) { struct timeval tmp; GETTIMEOFDAY(&current_time); tmp.tv_sec=sp[-args].u.integer; tmp.tv_usec=0; my_subtract_timeval(&tmp,&current_time); pop_n_elems(args); push_float( - (float)tmp.tv_sec - ((float)tmp.tv_usec)/1000000 ); return; } } pop_n_elems(args);
7b52a01998-03-10Henrik Grubbström (Grubba)  push_int(current_time.tv_sec);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_crypt(INT32 args) { char salt[2];
8beaf71996-04-13Fredrik Hübinette (Hubbe)  char *ret, *saltp;
5267b71995-08-09Fredrik Hübinette (Hubbe)  char *choise = "cbhisjKlm4k65p7qrJfLMNQOPxwzyAaBDFgnoWXYCZ0123tvdHueEGISRTUV89./"; if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("crypt", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("crypt", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args>1) { if(sp[1-args].type != T_STRING || sp[1-args].u.string->len < 2)
0f6deb1997-08-06Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0); return; }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
8beaf71996-04-13Fredrik Hübinette (Hubbe)  saltp=sp[1-args].u.string->str;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } else {
99e2121996-09-23Fredrik Hübinette (Hubbe)  unsigned int foo; /* Sun CC want's this :( */ foo=my_rand(); salt[0] = choise[foo % (unsigned int) strlen(choise)]; foo=my_rand(); salt[1] = choise[foo % (unsigned int) strlen(choise)];
8beaf71996-04-13Fredrik Hübinette (Hubbe)  saltp=salt;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } #ifdef HAVE_CRYPT
8beaf71996-04-13Fredrik Hübinette (Hubbe)  ret = (char *)crypt(sp[-args].u.string->str, saltp);
5267b71995-08-09Fredrik Hübinette (Hubbe) #else #ifdef HAVE__CRYPT
8beaf71996-04-13Fredrik Hübinette (Hubbe)  ret = (char *)_crypt(sp[-args].u.string->str, saltp);
5267b71995-08-09Fredrik Hübinette (Hubbe) #else ret = sp[-args].u.string->str; #endif #endif if(args < 2) { pop_n_elems(args); push_string(make_shared_string(ret)); }else{ int i; i=!strcmp(ret,sp[1-args].u.string->str); pop_n_elems(args); push_int(i); } } void f_destruct(INT32 args) { struct object *o; if(args) { if(sp[-args].type != T_OBJECT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("destruct", "Bad arguments 1.\n", sp, args);
cb22561995-10-11Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  o=sp[-args].u.object;
cb22561995-10-11Fredrik Hübinette (Hubbe)  }else{ if(!fp)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("destruct", "Destruct called without argument from callback function.\n", sp, args);
cb22561995-10-11Fredrik Hübinette (Hubbe)  o=fp->current_object;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } destruct(o);
cb22561995-10-11Fredrik Hübinette (Hubbe)  pop_n_elems(args);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_indices(INT32 args) { INT32 size; struct array *a; if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("indices", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  switch(sp[-args].type) { case T_STRING: size=sp[-args].u.string->len; goto qjump; case T_ARRAY: size=sp[-args].u.array->size; qjump:
99946c1996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(size,0);
5c8e891995-10-29Fredrik Hübinette (Hubbe)  while(--size>=0)
99946c1996-02-17Fredrik Hübinette (Hubbe)  { ITEM(a)[size].type=T_INT; ITEM(a)[size].subtype=NUMBER_NUMBER; ITEM(a)[size].u.integer=size; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_MAPPING:
ed70b71996-06-09Fredrik Hübinette (Hubbe)  a=mapping_indices(sp[-args].u.mapping);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET: a=copy_array(sp[-args].u.multiset->ind);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
6d4c4c1995-11-06Fredrik Hübinette (Hubbe)  case T_OBJECT: a=object_indices(sp[-args].u.object); break;
fa31451998-05-25Henrik Grubbström (Grubba)  case T_PROGRAM: a = program_indices(sp[-args].u.program); break;
0ceb871998-06-07Henrik Grubbström (Grubba)  case T_FUNCTION: { struct program *p = program_from_svalue(sp-args); if (p) { a = program_indices(p); break; } } /* FALL THROUGH */
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("indices", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; /* make apcc happy */ } pop_n_elems(args); push_array(a); } void f_values(INT32 args) { INT32 size; struct array *a; if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("values", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  switch(sp[-args].type) { case T_STRING:
c628dc1998-10-10Henrik Grubbström (Grubba)  size = sp[-args].u.string->len; a = allocate_array_no_init(size,0); while(--size >= 0)
99946c1996-02-17Fredrik Hübinette (Hubbe)  {
c628dc1998-10-10Henrik Grubbström (Grubba)  ITEM(a)[size].type = T_INT; ITEM(a)[size].subtype = NUMBER_NUMBER; ITEM(a)[size].u.integer = index_shared_string(sp[-args].u.string, size);
99946c1996-02-17Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  break; case T_ARRAY: a=copy_array(sp[-args].u.array); break; case T_MAPPING:
ed70b71996-06-09Fredrik Hübinette (Hubbe)  a=mapping_values(sp[-args].u.mapping);
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
06983f1996-09-22Fredrik Hübinette (Hubbe)  case T_MULTISET: size=sp[-args].u.multiset->ind->size;
99946c1996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(size,0); while(--size>=0) { ITEM(a)[size].type=T_INT; ITEM(a)[size].subtype=NUMBER_NUMBER; ITEM(a)[size].u.integer=1; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
6d4c4c1995-11-06Fredrik Hübinette (Hubbe)  case T_OBJECT: a=object_values(sp[-args].u.object); break;
fa31451998-05-25Henrik Grubbström (Grubba)  case T_PROGRAM: a = program_values(sp[-args].u.program); break;
0ceb871998-06-07Henrik Grubbström (Grubba)  case T_FUNCTION: { struct program *p = program_from_svalue(sp - args); if (p) { a = program_values(p); break; } } /* FALL THROUGH */
5267b71995-08-09Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("values", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return; /* make apcc happy */ } pop_n_elems(args); push_array(a); } void f_next_object(INT32 args) { struct object *o; if(args < 1) { o=first_object; }else{ if(sp[-args].type != T_OBJECT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("next_object", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  o=sp[-args].u.object->next; } pop_n_elems(args); if(!o) { push_int(0); }else{
0e88611998-04-16Fredrik Hübinette (Hubbe)  ref_push_object(o);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } void f_object_program(INT32 args) { if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("object_program", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
b301041996-11-26Fredrik Hübinette (Hubbe)  if(sp[-args].type == T_OBJECT)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  struct object *o=sp[-args].u.object; struct program *p; if((p=o->prog)) { if(o->parent && o->parent->prog) { INT32 id=o->parent_identifier; o=o->parent;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(o);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_object(o); sp[-1].subtype=id; sp[-1].type=T_FUNCTION; return; }else{
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(p);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_program(p); return; } }
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(0);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_reverse(INT32 args) { if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("reverse", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  switch(sp[-args].type) { case T_STRING: { INT32 e;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  s=begin_wide_shared_string(sp[-args].u.string->len, sp[-args].u.string->size_shift); switch(sp[-args].u.string->size_shift) { case 0: for(e=0;e<sp[-args].u.string->len;e++) STR0(s)[e]=STR0(sp[-args].u.string)[sp[-args].u.string->len-1-e]; break; case 1: for(e=0;e<sp[-args].u.string->len;e++) STR1(s)[e]=STR1(sp[-args].u.string)[sp[-args].u.string->len-1-e]; break; case 2: for(e=0;e<sp[-args].u.string->len;e++) STR2(s)[e]=STR2(sp[-args].u.string)[sp[-args].u.string->len-1-e]; break; } s=low_end_shared_string(s);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_string(s); break; } case T_INT: { INT32 e; e=sp[-args].u.integer;
5c8e891995-10-29Fredrik Hübinette (Hubbe)  e=((e & 0x55555555UL)<<1) + ((e & 0xaaaaaaaaUL)>>1); e=((e & 0x33333333UL)<<2) + ((e & 0xccccccccUL)>>2); e=((e & 0x0f0f0f0fUL)<<4) + ((e & 0xf0f0f0f0UL)>>4); e=((e & 0x00ff00ffUL)<<8) + ((e & 0xff00ff00UL)>>8); e=((e & 0x0000ffffUL)<<16)+ ((e & 0xffff0000UL)>>16);
5267b71995-08-09Fredrik Hübinette (Hubbe)  sp[-args].u.integer=e; pop_n_elems(args-1); break; } case T_ARRAY: { struct array *a; a=reverse_array(sp[-args].u.array); pop_n_elems(args); push_array(a); break; } default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("reverse", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } struct tupel {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *ind,*val;
5267b71995-08-09Fredrik Hübinette (Hubbe) }; static int replace_sortfun(void *a,void *b) { return my_quick_strcmp( ((struct tupel *)a)->ind, ((struct tupel *)b)->ind); }
06983f1996-09-22Fredrik Hübinette (Hubbe) static struct pike_string * replace_many(struct pike_string *str,
3beb891996-06-21Fredrik Hübinette (Hubbe)  struct array *from, struct array *to)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
3e625c1998-10-11Fredrik Hübinette (Hubbe)  INT32 s,length,e,num; struct string_builder ret;
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct tupel *v; int set_start[256]; int set_end[256]; if(from->size != to->size) error("Replace must have equal-sized from and to arrays.\n"); if(!from->size) { reference_shared_string(str); return str; } v=(struct tupel *)xalloc(sizeof(struct tupel)*from->size);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(num=e=0;e<from->size;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
99946c1996-02-17Fredrik Hübinette (Hubbe)  if(ITEM(from)[e].type != T_STRING)
3e625c1998-10-11Fredrik Hübinette (Hubbe)  { free((char *)v);
c4d5f81998-07-20Henrik Grubbström (Grubba)  error("Replace: from array is not array(string)\n");
3e625c1998-10-11Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
99946c1996-02-17Fredrik Hübinette (Hubbe)  if(ITEM(to)[e].type != T_STRING)
3e625c1998-10-11Fredrik Hübinette (Hubbe)  { free((char *)v);
c4d5f81998-07-20Henrik Grubbström (Grubba)  error("Replace: to array is not array(string)\n");
3e625c1998-10-11Fredrik Hübinette (Hubbe)  } if(ITEM(from)[e].u.string->size_shift > str->size_shift) continue; v[num].ind=ITEM(from)[e].u.string; v[num].val=ITEM(to)[e].u.string; num++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  fsort((char *)v,num,sizeof(struct tupel),(fsortfun)replace_sortfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(e=0;e<(INT32)NELEM(set_end);e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  set_end[e]=set_start[e]=0;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(e=0;e<num;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
3e625c1998-10-11Fredrik Hübinette (Hubbe)  INT32 x; x=index_shared_string(v[num-1-e].ind,0); if(x<(INT32)NELEM(set_start)) set_start[x]=num-e-1; x=index_shared_string(v[e].ind,0); if(x<(INT32)NELEM(set_end)) set_end[x]=e+1;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  init_string_builder(&ret,str->size_shift);
5267b71995-08-09Fredrik Hübinette (Hubbe)  length=str->len;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  for(s=0;length > 0;)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
3e625c1998-10-11Fredrik Hübinette (Hubbe)  INT32 a,b,c,ch; ch=index_shared_string(str,s); if(ch<(INT32)NELEM(set_end)) b=set_end[ch]; else b=num; if(b)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
3e625c1998-10-11Fredrik Hübinette (Hubbe)  if(ch<(INT32)NELEM(set_start)) a=set_start[ch]; else a=0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  while(a<b) { c=(a+b)/2;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  if(generic_quick_binary_strcmp(v[c].ind->str, v[c].ind->len, v[c].ind->size_shift, str->str+(s << str->size_shift), length, str->size_shift) <=0)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { if(a==c) break; a=c; }else{ b=c; } }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  if(a<num &&
afa3651996-02-10Fredrik Hübinette (Hubbe)  length >= v[a].ind->len &&
3e625c1998-10-11Fredrik Hübinette (Hubbe)  !generic_quick_binary_strcmp(v[a].ind->str, v[a].ind->len, v[a].ind->size_shift, str->str+(s<<str->size_shift), v[a].ind->len, str->size_shift))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { c=v[a].ind->len; if(!c) c=1; s+=c; length-=c;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  string_builder_shared_strcat(&ret,v[a].val);
5267b71995-08-09Fredrik Hübinette (Hubbe)  continue; } }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  string_builder_putchar(&ret, ch);
5267b71995-08-09Fredrik Hübinette (Hubbe)  s++; length--; } free((char *)v);
3e625c1998-10-11Fredrik Hübinette (Hubbe)  return finish_string_builder(&ret);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void f_replace(INT32 args) { if(args < 3)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("replace", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  switch(sp[-args].type) { case T_ARRAY: { array_replace(sp[-args].u.array,sp+1-args,sp+2-args); pop_n_elems(args-1); break; } case T_MAPPING: {
ed70b71996-06-09Fredrik Hübinette (Hubbe)  mapping_replace(sp[-args].u.mapping,sp+1-args,sp+2-args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); break; } case T_STRING: {
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *s;
5267b71995-08-09Fredrik Hübinette (Hubbe)  switch(sp[1-args].type) { default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("replace", "Bad argument 2.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_STRING: if(sp[2-args].type != T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("replace", "Bad argument 3.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  s=string_replace(sp[-args].u.string, sp[1-args].u.string, sp[2-args].u.string); break; case T_ARRAY: if(sp[2-args].type != T_ARRAY)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("replace", "Bad argument 3.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  s=replace_many(sp[-args].u.string, sp[1-args].u.array, sp[2-args].u.array); } pop_n_elems(args); push_string(s); break; }
8b63781996-04-11Fredrik Hübinette (Hubbe)  default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("replace", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
b1f4eb1998-01-13Fredrik Hübinette (Hubbe) void f_compile(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct program *p;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(args < 1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("compile", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("compile", "Bad argument 1.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if(sp[-args].u.string->size_shift) PIKE_ERROR("compile", "Wide strings not supported yet.\n", sp, args);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  p=compile(sp[-args].u.string);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_program(p); } void f_mkmapping(INT32 args) { struct mapping *m;
3c197b1997-02-18Fredrik Hübinette (Hubbe)  struct array *a,*b; get_all_args("mkmapping",args,"%a%a",&a,&b); if(a->size != b->size)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("mkmapping", "mkmapping called on arrays of different sizes\n",
7cc8311998-04-10Henrik Grubbström (Grubba)  sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  m=mkmapping(sp[-args].u.array, sp[1-args].u.array); pop_n_elems(args); push_mapping(m); } void f_objectp(INT32 args) {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  if(args<1) PIKE_ERROR("objectp", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_OBJECT || !sp[-args].u.object->prog) { pop_n_elems(args); push_int(0); }else{ pop_n_elems(args); push_int(1); } } void f_functionp(INT32 args) {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  if(args<1) PIKE_ERROR("functionp", "Too few arguments.\n", sp, args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_FUNCTION ||
bdb5091996-09-25Fredrik Hübinette (Hubbe)  (sp[-args].subtype != FUNCTION_BUILTIN && !sp[-args].u.object->prog))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { pop_n_elems(args); push_int(0); }else{ pop_n_elems(args); push_int(1); } }
89b0721998-05-05Fredrik Hübinette (Hubbe) #ifndef HAVE_AND_USE_POLL #undef HAVE_POLL #endif
cb22561995-10-11Fredrik Hübinette (Hubbe) void f_sleep(INT32 args) {
3beb891996-06-21Fredrik Hübinette (Hubbe)  struct timeval t1,t2,t3;
cb22561995-10-11Fredrik Hübinette (Hubbe)  INT32 a,b;
3beb891996-06-21Fredrik Hübinette (Hubbe)  if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("sleep", "Too few arguments.\n", sp, args);
3beb891996-06-21Fredrik Hübinette (Hubbe)  switch(sp[-args].type) { case T_INT: t2.tv_sec=sp[-args].u.integer; t2.tv_usec=0; break; case T_FLOAT: { FLOAT_TYPE f; f=sp[-args].u.float_number; t2.tv_sec=floor(f); t2.tv_usec=(long)(1000000.0*(f-floor(f))); break; } default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("sleep", "Bad argument 1.\n", sp, args);
3beb891996-06-21Fredrik Hübinette (Hubbe)  }
cb22561995-10-11Fredrik Hübinette (Hubbe)  pop_n_elems(args);
b48f281998-03-26Henrik Grubbström (Grubba) 
cb22561995-10-11Fredrik Hübinette (Hubbe) 
89b0721998-05-05Fredrik Hübinette (Hubbe)  if( args >1 && !IS_ZERO(sp-args+1)) {
07513e1996-10-04Fredrik Hübinette (Hubbe)  THREADS_ALLOW();
89b0721998-05-05Fredrik Hübinette (Hubbe) #ifdef __NT__ Sleep(t2.tv_sec * 1000 + t2.tv_usec / 1000); #elif defined(HAVE_POLL) poll(NULL, 0, t2.tv_sec * 1000 + t2.tv_usec / 1000); #else select(0,0,0,0,&t2); #endif
07513e1996-10-04Fredrik Hübinette (Hubbe)  THREADS_DISALLOW();
89b0721998-05-05Fredrik Hübinette (Hubbe)  }else{ GETTIMEOFDAY(&t1); my_add_timeval(&t1, &t2); while(1) { GETTIMEOFDAY(&t2); if(my_timercmp(&t1, <= , &t2)) return; t3=t1; my_subtract_timeval(&t3, &t2); THREADS_ALLOW(); #ifdef __NT__ Sleep(t3.tv_sec * 1000 + t3.tv_usec / 1000); #elif defined(HAVE_POLL) poll(NULL, 0, t3.tv_sec * 1000 + t3.tv_usec / 1000); #else select(0,0,0,0,&t3); #endif THREADS_DISALLOW(); check_signals(0,0,0); }
cb22561995-10-11Fredrik Hübinette (Hubbe)  } }
624d091996-02-24Fredrik Hübinette (Hubbe) void f_gc(INT32 args) { INT32 tmp; pop_n_elems(args); tmp=num_objects; do_gc(); push_int(tmp - num_objects); }
5267b71995-08-09Fredrik Hübinette (Hubbe) #ifdef TYPEP #undef TYPEP #endif #define TYPEP(ID,NAME,TYPE) \ void ID(INT32 args) \ { \ int t; \
aa366d1998-04-16Fredrik Hübinette (Hubbe)  if(args<1) PIKE_ERROR(NAME, "Too few arguments.\n", sp, args); \
5267b71995-08-09Fredrik Hübinette (Hubbe)  t=sp[-args].type == TYPE; \ pop_n_elems(args); \ push_int(t); \ }
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  void f_programp(INT32 args) { if(args<1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("programp", "Too few arguments.\n", sp, args);
b1f4eb1998-01-13Fredrik Hübinette (Hubbe)  switch(sp[-args].type) { case T_PROGRAM: pop_n_elems(args); push_int(1); return; case T_FUNCTION: if(program_from_function(sp-args)) { pop_n_elems(args); push_int(1); return; } default: pop_n_elems(args); push_int(0); } }
5267b71995-08-09Fredrik Hübinette (Hubbe) TYPEP(f_intp, "intpp", T_INT) TYPEP(f_mappingp, "mappingp", T_MAPPING) TYPEP(f_arrayp, "arrayp", T_ARRAY)
06983f1996-09-22Fredrik Hübinette (Hubbe) TYPEP(f_multisetp, "multisetp", T_MULTISET)
5267b71995-08-09Fredrik Hübinette (Hubbe) TYPEP(f_stringp, "stringp", T_STRING) TYPEP(f_floatp, "floatp", T_FLOAT)
ed70b71996-06-09Fredrik Hübinette (Hubbe) void f_sort(INT32 args) { INT32 e,*order;
bee4301997-02-24Fredrik Hübinette (Hubbe)  if(args < 1)
ed70b71996-06-09Fredrik Hübinette (Hubbe)  fatal("Too few arguments to sort().\n"); for(e=0;e<args;e++) { if(sp[e-args].type != T_ARRAY) error("Bad argument %ld to sort().\n",(long)(e+1)); if(sp[e-args].u.array->size != sp[-args].u.array->size) error("Argument %ld to sort() has wrong size.\n",(long)(e+1)); }
3beb891996-06-21Fredrik Hübinette (Hubbe)  if(args > 1) { order=get_alpha_order(sp[-args].u.array); for(e=0;e<args;e++) order_array(sp[e-args].u.array,order); free((char *)order); pop_n_elems(args-1); } else { sort_array_destructively(sp[-args].u.array); }
ed70b71996-06-09Fredrik Hübinette (Hubbe) } void f_rows(INT32 args) { INT32 e; struct array *a,*tmp; if(args < 2)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("rows", "Too few arguments.\n", sp, args);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  if(sp[1-args].type!=T_ARRAY)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("rows", "Bad argument 1.\n", sp, args);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  tmp=sp[1-args].u.array; push_array(a=allocate_array(tmp->size)); for(e=0;e<a->size;e++) index_no_free(ITEM(a)+e, sp-args-1, ITEM(tmp)+e);
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(a);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  pop_n_elems(args+1); push_array(a); } void f_column(INT32 args) { INT32 e; struct array *a,*tmp;
fc33451997-10-02Fredrik Hübinette (Hubbe)  DECLARE_CYCLIC();
ed70b71996-06-09Fredrik Hübinette (Hubbe)  if(args < 2)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("column", "Too few arguments.\n", sp, args);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  if(sp[-args].type!=T_ARRAY)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("column", "Bad argument 1.\n", sp, args);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  tmp=sp[-args].u.array;
fc33451997-10-02Fredrik Hübinette (Hubbe)  if((a=(struct array *)BEGIN_CYCLIC(tmp,0))) {
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(a);
fc33451997-10-02Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_array(a); }else{ push_array(a=allocate_array(tmp->size)); SET_CYCLIC_RET(a);
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
fc33451997-10-02Fredrik Hübinette (Hubbe)  for(e=0;e<a->size;e++) index_no_free(ITEM(a)+e, ITEM(tmp)+e, sp-args);
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
fc33451997-10-02Fredrik Hübinette (Hubbe)  END_CYCLIC();
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(a);
fc33451997-10-02Fredrik Hübinette (Hubbe)  pop_n_elems(args+1); push_array(a); }
ed70b71996-06-09Fredrik Hübinette (Hubbe) }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
ed70b71996-06-09Fredrik Hübinette (Hubbe) void f__verify_internals(INT32 args) {
05590d1998-04-23Fredrik Hübinette (Hubbe)  INT32 tmp=d_flag;
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("_exit: permission denied.\n"));
ed70b71996-06-09Fredrik Hübinette (Hubbe)  d_flag=0x7fffffff; do_debug(); d_flag=tmp;
0381531996-09-25Fredrik Hübinette (Hubbe)  do_gc();
ed70b71996-06-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); }
a03d951997-10-14Fredrik Hübinette (Hubbe) void f__debug(INT32 args) { INT32 i=d_flag;
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("_exit: permission denied.\n"));
a03d951997-10-14Fredrik Hübinette (Hubbe)  get_all_args("_debug",args,"%i",&d_flag); pop_n_elems(args); push_int(i); }
2f54f71998-04-13Henrik Grubbström (Grubba) #ifdef YYDEBUG void f__compiler_trace(INT32 args) { extern int yydebug; INT32 i = yydebug;
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("_exit: permission denied.\n"));
2f54f71998-04-13Henrik Grubbström (Grubba)  get_all_args("_compiler_trace", args, "%i", &yydebug); pop_n_elems(args); push_int(i); } #endif /* YYDEBUG */
ed70b71996-06-09Fredrik Hübinette (Hubbe) #endif
fe91501998-07-26Peter J. Holzer #if defined(HAVE_LOCALTIME) || defined(HAVE_GMTIME) static void encode_struct_tm(struct tm *tm)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_string(make_shared_string("sec")); push_int(tm->tm_sec); push_string(make_shared_string("min")); push_int(tm->tm_min); push_string(make_shared_string("hour")); push_int(tm->tm_hour);
7bd0ea1996-02-19Fredrik Hübinette (Hubbe) 
3beb891996-06-21Fredrik Hübinette (Hubbe)  push_string(make_shared_string("mday")); push_int(tm->tm_mday); push_string(make_shared_string("mon")); push_int(tm->tm_mon); push_string(make_shared_string("year")); push_int(tm->tm_year); push_string(make_shared_string("wday")); push_int(tm->tm_wday); push_string(make_shared_string("yday")); push_int(tm->tm_yday); push_string(make_shared_string("isdst")); push_int(tm->tm_isdst);
fe91501998-07-26Peter J. Holzer } #endif #ifdef HAVE_GMTIME void f_gmtime(INT32 args) { struct tm *tm; time_t t; if (args<1 || sp[-1].type!=T_INT) PIKE_ERROR("localtime", "Bad argument to localtime", sp, args); t=sp[-1].u.integer; tm=gmtime(&t); pop_n_elems(args); encode_struct_tm(tm); push_string(make_shared_string("timezone")); push_int(0); f_aggregate_mapping(20); } #endif #ifdef HAVE_LOCALTIME void f_localtime(INT32 args) { struct tm *tm; time_t t; if (args<1 || sp[-1].type!=T_INT) PIKE_ERROR("localtime", "Bad argument to localtime", sp, args); t=sp[-1].u.integer; tm=localtime(&t); pop_n_elems(args); encode_struct_tm(tm);
3beb891996-06-21Fredrik Hübinette (Hubbe)  #ifdef HAVE_EXTERNAL_TIMEZONE push_string(make_shared_string("timezone")); push_int(timezone); f_aggregate_mapping(20); #else #ifdef STRUCT_TM_HAS_GMTOFF push_string(make_shared_string("timezone")); push_int(tm->tm_gmtoff); f_aggregate_mapping(20); #else f_aggregate_mapping(18); #endif
c5d9811996-05-16Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) }
3beb891996-06-21Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) 
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) #ifdef HAVE_MKTIME static void f_mktime (INT32 args) {
5db18e1998-05-07Fredrik Hübinette (Hubbe)  INT32 sec, min, hour, mday, mon, year, isdst;
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  struct tm date; struct svalue s; struct svalue * r; int retval; if (args<1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("mktime", "Too few arguments.\n", sp, args);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  if(args == 1) { MEMSET(&date, 0, sizeof(date)); push_text("sec"); push_text("min"); push_text("hour"); push_text("mday"); push_text("mon"); push_text("year"); push_text("isdst"); push_text("timezone"); f_aggregate(8); f_rows(2); sp--; push_array_items(sp->u.array); args=8; }
5db18e1998-05-07Fredrik Hübinette (Hubbe)  get_all_args("mktime",args, "%i%i%i%i%i%i", &sec, &min, &hour, &mday, &mon, &year);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) 
5db18e1998-05-07Fredrik Hübinette (Hubbe)  MEMSET(&date, 0, sizeof(date));
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  date.tm_sec=sec; date.tm_min=min; date.tm_hour=hour; date.tm_mday=mday; date.tm_mon=mon; date.tm_year=year;
5db18e1998-05-07Fredrik Hübinette (Hubbe)  if(sp[6-args].subtype == NUMBER_NUMBER) { date.tm_isdst=sp[6-args].u.integer; }else{ date.tm_isdst=-1; }
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  #if STRUCT_TM_HAS_GMTOFF
5db18e1998-05-07Fredrik Hübinette (Hubbe)  if(sp[7-args].subtype == NUMBER_NUMBER) { date.tm_gmtoff=sp[7-args].u.intger; }else{ time_t tmp=0; data.tm_gmtoff=localtime(&t).tm_gmtoff; }
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  retval=mktime(&date); #else #ifdef HAVE_EXTERNAL_TIMEZONE
5db18e1998-05-07Fredrik Hübinette (Hubbe)  if(sp[7-args].subtype == NUMBER_NUMBER)
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  {
5db18e1998-05-07Fredrik Hübinette (Hubbe)  retval=mktime(&date) + sp[7-args].u.integer - timezone;
2befad1997-01-28Fredrik Hübinette (Hubbe)  }else{ retval=mktime(&date);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  } #else retval=mktime(&date); #endif #endif if (retval == -1)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("mktime", "Cannot convert.\n", sp, args);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_int(retval); } #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) 
156fd51997-10-27Fredrik Hübinette (Hubbe) /* Check if the string s[0..len[ matches the glob m[0..mlen[ */
0bc4cf1998-10-13Fredrik Hübinette (Hubbe) static int does_match(struct pike_string *s,int j, struct pike_string *m,int i)
ed70b71996-06-09Fredrik Hübinette (Hubbe) {
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  for (; i<m->len; i++)
ed70b71996-06-09Fredrik Hübinette (Hubbe)  {
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  switch (index_shared_string(m,i))
ed70b71996-06-09Fredrik Hübinette (Hubbe)  {
7a1bed1996-12-01Fredrik Hübinette (Hubbe)  case '?':
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if(j++>=s->len) return 0;
7a1bed1996-12-01Fredrik Hübinette (Hubbe)  break;
ed70b71996-06-09Fredrik Hübinette (Hubbe)  case '*': i++;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if (i==m->len) return 1; /* slut */
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  for (;j<s->len;j++) if (does_match(s,j,m,i))
ed70b71996-06-09Fredrik Hübinette (Hubbe)  return 1; return 0; default:
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if(j>=s->len || index_shared_string(m,i)!=index_shared_string(s,j)) return 0;
7a1bed1996-12-01Fredrik Hübinette (Hubbe)  j++;
ed70b71996-06-09Fredrik Hübinette (Hubbe)  } }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  return j==s->len;
ed70b71996-06-09Fredrik Hübinette (Hubbe) } void f_glob(INT32 args) { INT32 i,matches; struct array *a;
3beb891996-06-21Fredrik Hübinette (Hubbe)  struct svalue *sval, tmp;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *glob;
ed70b71996-06-09Fredrik Hübinette (Hubbe)  if(args < 2)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("glob", "Too few arguments.\n", sp, args);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  if(args > 2) pop_n_elems(args-2);
3beb891996-06-21Fredrik Hübinette (Hubbe)  args=2;
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
3beb891996-06-21Fredrik Hübinette (Hubbe)  if (sp[-args].type!=T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("glob", "Bad argument 2.\n", sp, args);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  glob=sp[-args].u.string;
3beb891996-06-21Fredrik Hübinette (Hubbe)  switch(sp[1-args].type)
ed70b71996-06-09Fredrik Hübinette (Hubbe)  { case T_STRING:
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  i=does_match(sp[1-args].u.string,0,glob,0);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  pop_n_elems(2); push_int(i); break; case T_ARRAY:
3beb891996-06-21Fredrik Hübinette (Hubbe)  a=sp[1-args].u.array; matches=0;
ed70b71996-06-09Fredrik Hübinette (Hubbe)  for(i=0;i<a->size;i++) {
5635941997-09-10Fredrik Hübinette (Hubbe)  if(ITEM(a)[i].type != T_STRING)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("glob", "Bad argument 2.\n", sp, args);
5635941997-09-10Fredrik Hübinette (Hubbe) 
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if(does_match(ITEM(a)[i].u.string,0,glob,0))
ed70b71996-06-09Fredrik Hübinette (Hubbe)  {
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(ITEM(a)[i].u.string);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  push_string(ITEM(a)[i].u.string); matches++; } } f_aggregate(matches); tmp=sp[-1]; sp--; pop_n_elems(2); sp[0]=tmp; sp++; break; default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("glob", "Bad argument 2.\n", sp, args);
ed70b71996-06-09Fredrik Hübinette (Hubbe)  } }
a7759e1998-11-17Henrik Grubbström (Grubba) /* comb_merge */ /* mixed interleave_array(array(mapping(int:mixed)) tab) */ static void f_interleave_array(INT32 args) { struct array *arr = NULL; struct array *min = NULL; struct array *order = NULL; int max = 0; int ok; int nelems = 0; int i; get_all_args("interleave_array", args, "%a", &arr); /* We're not interrested in any other arguments. */ pop_n_elems(args-1); if ((ok = arr->type_field & BIT_MAPPING) && (arr->type_field & ~BIT_MAPPING)) { /* Might be ok, but do some more checking... */ for(i = 0; i < arr->size; i++) { if (ITEM(arr)[i].type != T_MAPPING) { ok = 0; break; } } } if (!ok) { error("interleave_array(): Expected array(mapping(int:mixed))\n"); } /* The order array */ ref_push_array(arr); f_indices(1); order = sp[-1].u.array; /* The min array */ push_array(min = allocate_array(arr->size)); /* Initialize the min array */ for (i = 0; i < arr->size; i++) { struct mapping *m; /* e and k are used by MAPPING_LOOP() */ INT32 e; struct keypair *k; INT_TYPE low = 0x7fffffff;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
a7759e1998-11-17Henrik Grubbström (Grubba)  if (ITEM(arr)[i].type != T_MAPPING) { error("interleave_array(): Element %d is not a mapping!\n", i); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
a7759e1998-11-17Henrik Grubbström (Grubba)  m = ITEM(arr)[i].u.mapping; MAPPING_LOOP(m) { if (k->ind.type != T_INT) { error("interleave_array(): Index not an integer in mapping %d!\n", i); } if (low > k->ind.u.integer) { low = k->ind.u.integer; if (low < 0) { error("interleave_array(): Index %d in mapping %d is negative!\n", low, i); } } if (max < k->ind.u.integer) { max = k->ind.u.integer; } nelems++; } /* FIXME: Is this needed? Isn't T_INT default? */ ITEM(min)[i].u.integer = low; } ref_push_array(order); f_sort(2); /* Sort the order array on the minimum index */ /* State on stack now: * * array(mapping(int:mixed)) arr * array(int) order * array(int) min (now sorted) */ /* Now we can start with the real work... */ { char *tab; int size; int minfree = 0; /* Initialize the lookup table */ max += 1; max *= 2; /* max will be the padding at the end. */ size = (nelems + max) * 8; /* Initial size */ if (!(tab = malloc(size + max))) { error("interleave_array(): Out of memory!\n"); } MEMSET(tab, 0, size + max); for (i = 0; i < order->size; i++) { int low = ITEM(min)[i].u.integer; int j = ITEM(order)[i].u.integer; int offset = 0; struct mapping *m; INT32 e; struct keypair *k; if (!(m = ITEM(arr)[j].u.mapping)->size) { /* Not available */ ITEM(min)[i].u.integer = -1; continue; } if (low < minfree) { offset = minfree - low; } else { minfree = offset; } ok = 0; while (!ok) { ok = 1; MAPPING_LOOP(m) { int ind = k->ind.u.integer; if (tab[offset + ind]) { ok = 0; while (tab[++offset + ind]) ; } } } MAPPING_LOOP(m) { tab[offset + k->ind.u.integer] = 1; } while(tab[minfree]) { minfree++; } ITEM(min)[i].u.integer = offset; /* Check need for realloc */ if (offset >= size) { char *newtab = realloc(tab, size*2 + max); if (!newtab) { free(tab); error("interleave_array(): Couldn't extend table!\n"); } tab = newtab; MEMSET(tab + size + max, 0, size); size = size * 2; } } free(tab); } /* We want these two to survive the stackpopping. */ add_ref(min); add_ref(order); pop_n_elems(3); /* Return value */ ref_push_array(min); /* Restore the order */ push_array(order); push_array(min); f_sort(2); pop_stack(); }
7ce3a91998-02-12Henrik Grubbström (Grubba) /* longest_ordered_sequence */ static int find_gt(struct array *a, int i, int *stack, int top) { struct svalue *x = a->item + i; int l,h; if (!top || !is_lt(x, a->item + stack[top - 1])) return top; l = 0; h = top; while (l < h) { int middle = (l + h)/2; if (!is_gt(a->item + stack[middle], x)) { l = middle+1; } else { h = middle; } } return l; } static struct array *longest_ordered_sequence(struct array *a) { int *stack; int *links; int i,j,top=0,l=0,ltop=-1; struct array *res; ONERROR tmp; ONERROR tmp2; stack = malloc(sizeof(int)*a->size); links = malloc(sizeof(int)*a->size); if (!stack || !links) { if (stack) free(stack); if (links) free(links); return 0; } /* is_gt(), is_lt() and low_allocate_array() can generate errors. */ SET_ONERROR(tmp, free, stack); SET_ONERROR(tmp2, free, links); for (i=0; i<a->size; i++) { int pos; pos = find_gt(a, i, stack, top); if (pos == top) { top++; ltop = i; } if (pos != 0) links[i] = stack[pos-1]; else links[i] = -1; stack[pos] = i; } /* FIXME(?) memory unfreed upon error here */ res = low_allocate_array(top, 0); while (ltop != -1) { res->item[--top].u.integer = ltop; ltop = links[ltop]; } UNSET_ONERROR(tmp2); UNSET_ONERROR(tmp); free(stack); free(links); return res; } static void f_longest_ordered_sequence(INT32 args) { struct array *a = NULL; get_all_args("Array.longest_ordered_sequence", args, "%a", &a); /* THREADS_ALLOW(); */ a = longest_ordered_sequence(a); /* THREADS_DISALLOW(); */ if (!a) {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("Array.longest_ordered_sequence", "Out of memory", sp, args);
7ce3a91998-02-12Henrik Grubbström (Grubba)  } pop_n_elems(args); push_array(a); }
088e2e1998-02-12Mirar (Pontus Hagland) /**** diff ************************************************************/
f873831998-05-19Henrik Grubbström (Grubba) static struct array* diff_compare_table(struct array *a,struct array *b,int *u)
088e2e1998-02-12Mirar (Pontus Hagland) { struct array *res; struct mapping *map; struct svalue *pval; int i;
f873831998-05-19Henrik Grubbström (Grubba)  if (u) { *u = 0; /* Unique rows in array b */ }
088e2e1998-02-12Mirar (Pontus Hagland)  map=allocate_mapping(256); push_mapping(map); /* in case of out of memory */ for (i=0; i<b->size; i++) { pval=low_mapping_lookup(map,b->item+i); if (!pval) { struct svalue val; val.type=T_ARRAY; val.u.array=low_allocate_array(1,1); val.u.array->item[0].type=T_INT; val.u.array->item[0].subtype=NUMBER_NUMBER; val.u.array->item[0].u.integer=i; mapping_insert(map,b->item+i,&val); free_svalue(&val);
f873831998-05-19Henrik Grubbström (Grubba)  if (u) { (*u)++; }
088e2e1998-02-12Mirar (Pontus Hagland)  } else { pval->u.array=resize_array(pval->u.array,pval->u.array->size+1); pval->u.array->item[pval->u.array->size-1].type=T_INT; pval->u.array->item[pval->u.array->size-1].subtype=NUMBER_NUMBER; pval->u.array->item[pval->u.array->size-1].u.integer=i; } } res=low_allocate_array(a->size,0); for (i=0; i<a->size; i++) { pval=low_mapping_lookup(map,a->item+i); if (!pval) { res->item[i].type=T_ARRAY;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(res->item[i].u.array=&empty_array);
088e2e1998-02-12Mirar (Pontus Hagland)  } else { assign_svalue(res->item+i,pval); } } pop_stack(); return res; }
7083e31998-02-15Mirar (Pontus Hagland) struct diff_magic_link { int x; int refs; struct diff_magic_link *prev; }; struct diff_magic_link_pool { struct diff_magic_link *firstfree; struct diff_magic_link_pool *next; int firstfreenum; struct diff_magic_link dml[1]; };
f873831998-05-19Henrik Grubbström (Grubba) struct diff_magic_link_head { unsigned int depth; struct diff_magic_link *link; };
7083e31998-02-15Mirar (Pontus Hagland) #define DMLPOOLSIZE 16384 static int dmls=0; static INLINE struct diff_magic_link_pool* dml_new_pool(struct diff_magic_link_pool **pools) { struct diff_magic_link_pool *new;
088e2e1998-02-12Mirar (Pontus Hagland) 
7083e31998-02-15Mirar (Pontus Hagland)  new=malloc(sizeof(struct diff_magic_link_pool)+ sizeof(struct diff_magic_link)*DMLPOOLSIZE); if (!new) return NULL; /* fail */ new->firstfreenum=0; new->firstfree=NULL; new->next=*pools; *pools=new; return *pools; } static INLINE struct diff_magic_link* dml_new(struct diff_magic_link_pool **pools) { struct diff_magic_link *new; struct diff_magic_link_pool *pool; dmls++; if ( *pools && (new=(*pools)->firstfree) ) { (*pools)->firstfree=new->prev; new->prev=NULL; return new; } pool=*pools; while (pool) { if (pool->firstfreenum<DMLPOOLSIZE) return pool->dml+(pool->firstfreenum++); pool=pool->next; } if ( (pool=dml_new_pool(pools)) ) { pool->firstfreenum=1; return pool->dml; } return NULL; } static INLINE void dml_free_pools(struct diff_magic_link_pool *pools) { struct diff_magic_link_pool *pool; while (pools) { pool=pools->next; free(pools); pools=pool; } } static INLINE void dml_delete(struct diff_magic_link_pool *pools, struct diff_magic_link *dml) { if (dml->prev && !--dml->prev->refs) dml_delete(pools,dml->prev); dmls--; dml->prev=pools->firstfree; pools->firstfree=dml; } static INLINE int diff_ponder_stack(int x, struct diff_magic_link **dml, int top) { int middle,a,b; a=0; b=top; while (b>a) { middle=(a+b)/2; if (dml[middle]->x<x) a=middle+1; else if (dml[middle]->x>x) b=middle; else return middle; } if (a<top && dml[a]->x<x) a++; return a; } static INLINE int diff_ponder_array(int x, struct svalue *arr, int top)
088e2e1998-02-12Mirar (Pontus Hagland) { int middle,a,b; a=0; b=top; while (b>a) { middle=(a+b)/2;
7083e31998-02-15Mirar (Pontus Hagland)  if (arr[middle].u.integer<x) a=middle+1; else if (arr[middle].u.integer>x) b=middle;
088e2e1998-02-12Mirar (Pontus Hagland)  else return middle; }
7083e31998-02-15Mirar (Pontus Hagland)  if (a<top && arr[a].u.integer<x) a++;
088e2e1998-02-12Mirar (Pontus Hagland)  return a; }
69faad1998-03-16Henrik Grubbström (Grubba) /* * The Grubba-Mirar Longest Common Sequence algorithm. * * This algorithm is O((Na * Nb / K)*lg(Na * Nb / K)), where: * * Na == sizeof(a) * Nb == sizeof(b) * K == sizeof(correlation(a,b)) * * For binary data: * K == 256 => O(Na * Nb * lg(Na * Nb)), * Na ~= Nb ~= N => O(N² * lg(N)) * * For ascii data: * K ~= C * min(Na, Nb), C constant => O(max(Na, Nb)*lg(max(Na,Nb))), * Na ~= Nb ~= N => O(N * lg(N)) * * diff_longest_sequence() takes two arguments: * cmptbl == diff_compare_table(a, b) * blen == sizeof(b) >= max(@(cmptbl*({}))) */
f873831998-05-19Henrik Grubbström (Grubba) static struct array *diff_longest_sequence(struct array *cmptbl, int blen)
088e2e1998-02-12Mirar (Pontus Hagland) {
7083e31998-02-15Mirar (Pontus Hagland)  int i,j,top=0,lsize=0;
088e2e1998-02-12Mirar (Pontus Hagland)  struct array *a;
7083e31998-02-15Mirar (Pontus Hagland)  struct diff_magic_link_pool *pools=NULL; struct diff_magic_link *dml; struct diff_magic_link **stack;
7be6851998-02-24Henrik Grubbström (Grubba)  char *marks;
088e2e1998-02-12Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba)  stack = malloc(sizeof(struct diff_magic_link*)*cmptbl->size);
088e2e1998-02-12Mirar (Pontus Hagland) 
7cc8311998-04-10Henrik Grubbström (Grubba)  if (!stack) error("diff_longest_sequence(): Out of memory\n");
088e2e1998-02-12Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba)  /* NB: marks is used for optimization purposes only */
7be6851998-02-24Henrik Grubbström (Grubba)  marks = calloc(blen,1); if (!marks) { free(stack);
7cc8311998-04-10Henrik Grubbström (Grubba)  error("diff_longest_sequence(): Out of memory\n");
7be6851998-02-24Henrik Grubbström (Grubba)  }
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "\n\nDIFF: sizeof(cmptbl)=%d, blen=%d\n", cmptbl->size, blen); #endif /* DIFF_DEBUG */ for (i = 0; i<cmptbl->size; i++)
7083e31998-02-15Mirar (Pontus Hagland)  { struct svalue *inner=cmptbl->item[i].u.array->item;
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: i=%d\n", i); #endif /* DIFF_DEBUG */ for (j = cmptbl->item[i].u.array->size; j--;)
088e2e1998-02-12Mirar (Pontus Hagland)  {
69faad1998-03-16Henrik Grubbström (Grubba)  int x = inner[j].u.integer;
7083e31998-02-15Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: j=%d, x=%d\n", j, x); #endif /* DIFF_DEBUG */
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
978c1c1998-03-18Henrik Grubbström (Grubba)  if (x >= blen) { fatal("diff_longest_sequence(): x:%d >= blen:%d\n", x, blen); } else if (x < 0) { fatal("diff_longest_sequence(): x:%d < 0\n", x); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
7be6851998-02-24Henrik Grubbström (Grubba)  if (!marks[x]) { int pos; if (top && x<=stack[top-1]->x) {
69faad1998-03-16Henrik Grubbström (Grubba)  /* Find the insertion point. */ pos = diff_ponder_stack(x, stack, top);
7be6851998-02-24Henrik Grubbström (Grubba)  if (pos != top) {
69faad1998-03-16Henrik Grubbström (Grubba)  /* Not on the stack anymore. */
7be6851998-02-24Henrik Grubbström (Grubba)  marks[stack[pos]->x] = 0; } } else pos=top;
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: pos=%d\n", pos); #endif /* DIFF_DEBUG */ /* This part is only optimization (j accelleration). */
7be6851998-02-24Henrik Grubbström (Grubba)  if (pos && j) { if (!marks[inner[j-1].u.integer]) {
69faad1998-03-16Henrik Grubbström (Grubba)  /* Find the element to insert. */ j = diff_ponder_array(stack[pos-1]->x+1, inner, j); x = inner[j].u.integer;
7be6851998-02-24Henrik Grubbström (Grubba)  } } else {
69faad1998-03-16Henrik Grubbström (Grubba)  j = 0; x = inner->u.integer;
7be6851998-02-24Henrik Grubbström (Grubba)  }
69faad1998-03-16Henrik Grubbström (Grubba)  #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: New j=%d, x=%d\n", j, x); #endif /* DIFF_DEBUG */
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
978c1c1998-03-18Henrik Grubbström (Grubba)  if (x >= blen) { fatal("diff_longest_sequence(): x:%d >= blen:%d\n", x, blen); } else if (x < 0) { fatal("diff_longest_sequence(): x:%d < 0\n", x); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
69faad1998-03-16Henrik Grubbström (Grubba)  /* Put x on the stack. */
7be6851998-02-24Henrik Grubbström (Grubba)  marks[x] = 1;
69faad1998-03-16Henrik Grubbström (Grubba)  if (pos == top)
7be6851998-02-24Henrik Grubbström (Grubba)  {
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: New top element\n"); #endif /* DIFF_DEBUG */
7be6851998-02-24Henrik Grubbström (Grubba)  if (! (dml=dml_new(&pools)) ) {
7083e31998-02-15Mirar (Pontus Hagland)  dml_free_pools(pools); free(stack);
7cc8311998-04-10Henrik Grubbström (Grubba)  error("diff_longest_sequence(): Out of memory\n");
7be6851998-02-24Henrik Grubbström (Grubba)  }
7083e31998-02-15Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba)  dml->x = x; dml->refs = 1;
7083e31998-02-15Mirar (Pontus Hagland) 
7be6851998-02-24Henrik Grubbström (Grubba)  if (pos)
f873831998-05-19Henrik Grubbström (Grubba)  (dml->prev = stack[pos-1])->refs++;
7be6851998-02-24Henrik Grubbström (Grubba)  else
69faad1998-03-16Henrik Grubbström (Grubba)  dml->prev = NULL;
7083e31998-02-15Mirar (Pontus Hagland) 
7be6851998-02-24Henrik Grubbström (Grubba)  top++;
7083e31998-02-15Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba)  stack[pos] = dml; } else if (pos && stack[pos]->refs == 1 && stack[pos-1] == stack[pos]->prev) { #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: Optimized case\n"); #endif /* DIFF_DEBUG */ /* Optimization. */ stack[pos]->x = x; } else { #ifdef DIFF_DEBUG fprintf(stderr, "DIFF: Generic case\n"); #endif /* DIFF_DEBUG */ if (! (dml=dml_new(&pools)) )
7be6851998-02-24Henrik Grubbström (Grubba)  {
69faad1998-03-16Henrik Grubbström (Grubba)  dml_free_pools(pools); free(stack);
7cc8311998-04-10Henrik Grubbström (Grubba)  error("diff_longest_sequence: Out of memory\n");
7be6851998-02-24Henrik Grubbström (Grubba)  }
69faad1998-03-16Henrik Grubbström (Grubba)  dml->x = x; dml->refs = 1; if (pos)
f873831998-05-19Henrik Grubbström (Grubba)  (dml->prev = stack[pos-1])->refs++;
7be6851998-02-24Henrik Grubbström (Grubba)  else
69faad1998-03-16Henrik Grubbström (Grubba)  dml->prev = NULL; if (!--stack[pos]->refs) dml_delete(pools, stack[pos]);
7083e31998-02-15Mirar (Pontus Hagland) 
69faad1998-03-16Henrik Grubbström (Grubba)  stack[pos] = dml; } #ifdef DIFF_DEBUG } else { fprintf(stderr, "DIFF: Already marked (%d)!\n", marks[x]); #endif /* DIFF_DEBUG */
7be6851998-02-24Henrik Grubbström (Grubba)  }
088e2e1998-02-12Mirar (Pontus Hagland)  }
69faad1998-03-16Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG for(j=0; j < top; j++) { fprintf(stderr, "DIFF: stack:%d, mark:%d\n", stack[j]->x, marks[stack[j]->x]); } #endif /* DIFF_DEBUG */
7083e31998-02-15Mirar (Pontus Hagland)  }
088e2e1998-02-12Mirar (Pontus Hagland) 
7be6851998-02-24Henrik Grubbström (Grubba)  /* No need for marks anymore. */ free(marks);
69faad1998-03-16Henrik Grubbström (Grubba)  /* FIXME(?) memory unfreed upon error here. */
088e2e1998-02-12Mirar (Pontus Hagland)  a=low_allocate_array(top,0);
7083e31998-02-15Mirar (Pontus Hagland)  if (top)
088e2e1998-02-12Mirar (Pontus Hagland)  {
7083e31998-02-15Mirar (Pontus Hagland)  dml=stack[top-1]; while (dml) { a->item[--top].u.integer=dml->x; dml=dml->prev; }
088e2e1998-02-12Mirar (Pontus Hagland)  } free(stack);
7083e31998-02-15Mirar (Pontus Hagland)  dml_free_pools(pools);
088e2e1998-02-12Mirar (Pontus Hagland)  return a; }
f873831998-05-19Henrik Grubbström (Grubba) /* * The dynamic programming Longest Common Sequence algorithm. * * This algorithm is O(Na * Nb), where: * * Na == sizeof(a) * Nb == sizeof(b) * * This makes it faster than the G-M algorithm on binary data, * but slower on ascii data.
c337d91998-05-19Henrik Grubbström (Grubba)  * * NOT true! The G-M algorithm seems to be faster on most data anyway. * /grubba 1998-05-19
f873831998-05-19Henrik Grubbström (Grubba)  */
bde0ef1998-05-19Henrik Grubbström (Grubba) static struct array *diff_dyn_longest_sequence(struct array *cmptbl, int blen)
f873831998-05-19Henrik Grubbström (Grubba) { struct array *res = NULL; struct diff_magic_link_head *table = NULL; struct diff_magic_link_pool *dml_pool = NULL; struct diff_magic_link *dml;
bde0ef1998-05-19Henrik Grubbström (Grubba)  unsigned int sz = (unsigned int)cmptbl->size; unsigned int i;
f873831998-05-19Henrik Grubbström (Grubba)  unsigned int off1 = 0;
bde0ef1998-05-19Henrik Grubbström (Grubba)  unsigned int off2 = blen + 1;
92bb061998-05-19Henrik Grubbström (Grubba)  unsigned int l1 = 0; unsigned int l2 = 0;
bde0ef1998-05-19Henrik Grubbström (Grubba)  table = calloc(sizeof(struct diff_magic_link_head)*2, off2); if (!table) { error("diff_dyn_longest_sequence(): Out of memory"); } /* FIXME: Assumes NULL is represented with all zeroes */ /* NOTE: Scan strings backwards to get the same result as the G-M * algorithm. */ for (i = sz; i--;) { struct array *boff = cmptbl->item[i].u.array; #ifdef DIFF_DEBUG fprintf(stderr, " i:%d\n", i); #endif /* DIFF_DEBUG */
f873831998-05-19Henrik Grubbström (Grubba) 
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (boff->size) { unsigned int bi; unsigned int base = blen; unsigned int tmp = off1;
f873831998-05-19Henrik Grubbström (Grubba)  off1 = off2; off2 = tmp;
bde0ef1998-05-19Henrik Grubbström (Grubba)  for (bi = boff->size; bi--;) { unsigned int ib = boff->item[bi].u.integer; #ifdef DIFF_DEBUG fprintf(stderr, " Range [%d - %d] differ\n", base - 1, ib + 1); #endif /* DIFF_DEBUG */ while ((--base) > ib) {
f873831998-05-19Henrik Grubbström (Grubba)  /* Differ */
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (table[off1 + base].link) { if (!--(table[off1 + base].link->refs)) { dml_delete(dml_pool, table[off1 + base].link); } }
f873831998-05-19Henrik Grubbström (Grubba)  /* FIXME: Should it be > or >= here to get the same result * as with the G-M algorithm? */
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (table[off2 + base].depth > table[off1 + base + 1].depth) { table[off1 + base].depth = table[off2 + base].depth; dml = (table[off1 + base].link = table[off2 + base].link);
f873831998-05-19Henrik Grubbström (Grubba)  } else {
bde0ef1998-05-19Henrik Grubbström (Grubba)  table[off1 + base].depth = table[off1 + base + 1].depth; dml = (table[off1 + base].link = table[off1 + base + 1].link);
f873831998-05-19Henrik Grubbström (Grubba)  } if (dml) { dml->refs++; } }
bde0ef1998-05-19Henrik Grubbström (Grubba)  /* Equal */
f873831998-05-19Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  fprintf(stderr, " Equal\n");
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */ if (table[off1 + ib].link) { if (!--(table[off1 + ib].link->refs)) { dml_delete(dml_pool, table[off1 + ib].link); } }
bde0ef1998-05-19Henrik Grubbström (Grubba)  table[off1 + ib].depth = table[off2 + ib + 1].depth + 1; dml = (table[off1 + ib].link = dml_new(&dml_pool)); if (!dml) { dml_free_pools(dml_pool); free(table); error("diff_dyn_longest_sequence(): Out of memory"); } dml->refs = 1; dml->prev = table[off2 + ib + 1].link; if (dml->prev) { dml->prev->refs++; } dml->x = ib; }
f873831998-05-19Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  fprintf(stderr, " Range [0 - %d] differ\n", base-1);
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */
bde0ef1998-05-19Henrik Grubbström (Grubba)  while (base--) { /* Differ */ if (table[off1 + base].link) { if (!--(table[off1 + base].link->refs)) { dml_delete(dml_pool, table[off1 + base].link);
f873831998-05-19Henrik Grubbström (Grubba)  }
bde0ef1998-05-19Henrik Grubbström (Grubba)  } /* FIXME: Should it be > or >= here to get the same result * as with the G-M algorithm? */ if (table[off2 + base].depth > table[off1 + base + 1].depth) { table[off1 + base].depth = table[off2 + base].depth; dml = (table[off1 + base].link = table[off2 + base].link);
f873831998-05-19Henrik Grubbström (Grubba)  } else {
bde0ef1998-05-19Henrik Grubbström (Grubba)  table[off1 + base].depth = table[off1 + base + 1].depth; dml = (table[off1 + base].link = table[off1 + base + 1].link); } if (dml) { dml->refs++;
f873831998-05-19Henrik Grubbström (Grubba)  } } } } /* Convert table into res */
bde0ef1998-05-19Henrik Grubbström (Grubba)  sz = table[off1].depth;
f873831998-05-19Henrik Grubbström (Grubba)  dml = table[off1].link; free(table); #ifdef DIFF_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  fprintf(stderr, "Result array size:%d\n", sz);
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */
bde0ef1998-05-19Henrik Grubbström (Grubba)  res = allocate_array(sz);
f873831998-05-19Henrik Grubbström (Grubba)  if (!res) { if (dml_pool) { dml_free_pools(dml_pool); } error("diff_dyn_longest_sequence(): Out of memory"); }
bde0ef1998-05-19Henrik Grubbström (Grubba)  i = 0;
f873831998-05-19Henrik Grubbström (Grubba)  while(dml) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (i >= sz) {
f873831998-05-19Henrik Grubbström (Grubba)  fatal("Consistency error in diff_dyn_longest_sequence()\n"); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
f873831998-05-19Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  fprintf(stderr, " %02d: %d\n", i, dml->x);
f873831998-05-19Henrik Grubbström (Grubba) #endif /* DIFF_DEBUG */
bde0ef1998-05-19Henrik Grubbström (Grubba)  res->item[i].type = T_INT; res->item[i].subtype = 0; res->item[i].u.integer = dml->x;
f873831998-05-19Henrik Grubbström (Grubba)  dml = dml->prev;
bde0ef1998-05-19Henrik Grubbström (Grubba)  i++;
f873831998-05-19Henrik Grubbström (Grubba)  }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
bde0ef1998-05-19Henrik Grubbström (Grubba)  if (i != sz) {
f873831998-05-19Henrik Grubbström (Grubba)  fatal("Consistency error in diff_dyn_longest_sequence()\n"); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
f873831998-05-19Henrik Grubbström (Grubba)  dml_free_pools(dml_pool); return(res); }
088e2e1998-02-12Mirar (Pontus Hagland) static struct array* diff_build(struct array *a, struct array *b, struct array *seq) { struct array *ad,*bd; int bi,ai,lbi,lai,i,eqstart; /* FIXME(?) memory unfreed upon error here (and later) */ ad=low_allocate_array(0,32); bd=low_allocate_array(0,32); eqstart=0; lbi=bi=ai=-1; for (i=0; i<seq->size; i++) { bi=seq->item[i].u.integer; if (bi!=lbi+1 || !is_equal(a->item+ai+1,b->item+bi)) { /* insert the equality */ if (lbi>=eqstart) {
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(b,eqstart,lbi+1)); ad=append_array(ad,sp-1); bd=append_array(bd,sp-1); pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland)  } /* insert the difference */ lai=ai; ai=array_search(a,b->item+bi,ai+1)-1;
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(b,lbi+1,bi)); bd=append_array(bd, sp-1); pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland) 
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(a,lai+1,ai+1)); ad=append_array(ad,sp-1); pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland)  eqstart=bi; } ai++; lbi=bi; } if (lbi>=eqstart) {
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(b,eqstart,lbi+1)); ad=append_array(ad,sp-1); bd=append_array(bd,sp-1); pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland)  } if (b->size>bi+1 || a->size>ai+1) {
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(b,lbi+1,b->size)); bd=append_array(bd, sp-1); pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland) 
9649491998-02-27Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(a,ai+1,a->size)); ad=append_array(ad,sp-1); pop_stack();
088e2e1998-02-12Mirar (Pontus Hagland)  } push_array(ad); push_array(bd);
9649491998-02-27Fredrik Hübinette (Hubbe)  return aggregate_array(2);
088e2e1998-02-12Mirar (Pontus Hagland) } void f_diff(INT32 args) { struct array *seq; struct array *cmptbl; struct array *diff;
f873831998-05-19Henrik Grubbström (Grubba)  int uniq;
088e2e1998-02-12Mirar (Pontus Hagland)  if (args<2)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("diff", "Too few arguments.\n", sp, args);
088e2e1998-02-12Mirar (Pontus Hagland)  if (sp[-args].type!=T_ARRAY || sp[1-args].type!=T_ARRAY)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("diff", "Bad arguments.\n", sp, args);
088e2e1998-02-12Mirar (Pontus Hagland) 
f873831998-05-19Henrik Grubbström (Grubba)  cmptbl = diff_compare_table(sp[-args].u.array, sp[1-args].u.array, &uniq);
bde0ef1998-05-19Henrik Grubbström (Grubba)  push_array(cmptbl); #ifdef ENABLE_DYN_DIFF
f873831998-05-19Henrik Grubbström (Grubba)  if (uniq * 100 > sp[1-args].u.array->size) {
bde0ef1998-05-19Henrik Grubbström (Grubba) #endif /* ENABLE_DYN_DIFF */
f873831998-05-19Henrik Grubbström (Grubba) #ifdef DIFF_DEBUG fprintf(stderr, "diff: Using G-M algorithm, u:%d, s:%d\n", uniq, sp[1-args].u.array->size); #endif /* DIFF_DEBUG */
bde0ef1998-05-19Henrik Grubbström (Grubba)  seq = diff_longest_sequence(cmptbl, sp[1-1-args].u.array->size); #ifdef ENABLE_DYN_DIFF
f873831998-05-19Henrik Grubbström (Grubba)  } else { #ifdef DIFF_DEBUG fprintf(stderr, "diff: Using dyn algorithm, u:%d, s:%d\n", uniq, sp[1-args].u.array->size); #endif /* DIFF_DEBUG */
bde0ef1998-05-19Henrik Grubbström (Grubba)  seq = diff_dyn_longest_sequence(cmptbl, sp[1-1-args].u.array->size); } #endif /* ENABLE_DYN_DIFF */ push_array(seq); diff=diff_build(sp[-2-args].u.array,sp[1-2-args].u.array,seq);
088e2e1998-02-12Mirar (Pontus Hagland)  pop_n_elems(2+args); push_array(diff); } void f_diff_compare_table(INT32 args) { struct array *cmptbl; if (args<2)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("diff_compare_table", "Too few arguments.\n", sp, args);
088e2e1998-02-12Mirar (Pontus Hagland)  if (sp[-args].type!=T_ARRAY || sp[1-args].type!=T_ARRAY)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("diff_compare_table", "Bad arguments.\n", sp, args);
088e2e1998-02-12Mirar (Pontus Hagland) 
f873831998-05-19Henrik Grubbström (Grubba)  cmptbl=diff_compare_table(sp[-args].u.array,sp[1-args].u.array,NULL);
088e2e1998-02-12Mirar (Pontus Hagland)  pop_n_elems(args); push_array(cmptbl); } void f_diff_longest_sequence(INT32 args) { struct array *seq; struct array *cmptbl; if (args<2)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("diff_longest_sequence", "Too few arguments.\n", sp, args);
088e2e1998-02-12Mirar (Pontus Hagland)  if (sp[-args].type!=T_ARRAY || sp[1-args].type!=T_ARRAY)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("diff_longest_sequence", "Bad arguments.\n", sp, args);
088e2e1998-02-12Mirar (Pontus Hagland) 
bde0ef1998-05-19Henrik Grubbström (Grubba)  cmptbl = diff_compare_table(sp[-args].u.array,sp[1-args].u.array, NULL);
088e2e1998-02-12Mirar (Pontus Hagland)  push_array(cmptbl);
cbdad21998-03-06Henrik Grubbström (Grubba)  /* Note that the stack is one element off here. */
bde0ef1998-05-19Henrik Grubbström (Grubba)  seq = diff_longest_sequence(cmptbl, sp[1-1-args].u.array->size);
088e2e1998-02-12Mirar (Pontus Hagland)  pop_n_elems(args+1); push_array(seq); }
f873831998-05-19Henrik Grubbström (Grubba) void f_diff_dyn_longest_sequence(INT32 args) { struct array *seq;
bde0ef1998-05-19Henrik Grubbström (Grubba)  struct array *cmptbl;
f873831998-05-19Henrik Grubbström (Grubba)  if (args<2) PIKE_ERROR("diff_dyn_longest_sequence", "Too few arguments.\n", sp, args); if (sp[-args].type!=T_ARRAY || sp[1-args].type!=T_ARRAY) PIKE_ERROR("diff_dyn_longest_sequence", "Bad arguments.\n", sp, args);
bde0ef1998-05-19Henrik Grubbström (Grubba)  cmptbl=diff_compare_table(sp[-args].u.array,sp[1-args].u.array, NULL); push_array(cmptbl); /* Note that the stack is one element off here. */ seq = diff_dyn_longest_sequence(cmptbl, sp[1-1-args].u.array->size);
f873831998-05-19Henrik Grubbström (Grubba)  pop_n_elems(args); push_array(seq); }
088e2e1998-02-12Mirar (Pontus Hagland) /**********************************************************************/
c3c7031996-12-04Fredrik Hübinette (Hubbe) static struct callback_list memory_usage_callback; struct callback *add_memory_usage_callback(callback_func call, void *arg, callback_func free_func) { return add_to_callback(&memory_usage_callback, call, arg, free_func); } void f__memory_usage(INT32 args) { INT32 num,size; struct svalue *ss; pop_n_elems(args); ss=sp; count_memory_in_mappings(&num, &size); push_text("num_mappings"); push_int(num); push_text("mapping_bytes"); push_int(size); count_memory_in_strings(&num, &size); push_text("num_strings"); push_int(num); push_text("string_bytes"); push_int(size); count_memory_in_arrays(&num, &size); push_text("num_arrays"); push_int(num); push_text("array_bytes"); push_int(size); count_memory_in_programs(&num,&size); push_text("num_programs"); push_int(num); push_text("program_bytes"); push_int(size); count_memory_in_multisets(&num, &size); push_text("num_multisets"); push_int(num); push_text("multiset_bytes"); push_int(size); count_memory_in_objects(&num, &size); push_text("num_objects"); push_int(num);
4d58591996-12-04Fredrik Hübinette (Hubbe)  push_text("object_bytes");
c3c7031996-12-04Fredrik Hübinette (Hubbe)  push_int(size); count_memory_in_callbacks(&num, &size); push_text("num_callbacks"); push_int(num); push_text("callback_bytes"); push_int(size); count_memory_in_callables(&num, &size); push_text("num_callables"); push_int(num); push_text("callable_bytes"); push_int(size); call_callback(&memory_usage_callback, (void *)0); f_aggregate_mapping(sp-ss); }
8e9fdf1996-12-04Fredrik Hübinette (Hubbe) void f__next(INT32 args) { struct svalue tmp;
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("_next: permission denied.\n"));
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("_next", "Too few arguments.\n", sp, args);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); tmp=sp[-1]; switch(tmp.type) { case T_OBJECT: tmp.u.object=tmp.u.object->next; break; case T_ARRAY: tmp.u.array=tmp.u.array->next; break; case T_MAPPING: tmp.u.mapping=tmp.u.mapping->next; break; case T_MULTISET:tmp.u.multiset=tmp.u.multiset->next; break; case T_PROGRAM: tmp.u.program=tmp.u.program->next; break; case T_STRING: tmp.u.string=tmp.u.string->next; break; default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("_next", "Bad argument 1.\n", sp, args);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  } if(tmp.u.refs) { assign_svalue(sp-1,&tmp); }else{ pop_stack(); push_int(0); } } void f__prev(INT32 args) { struct svalue tmp;
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("_prev: permission denied.\n"));
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("_prev", "Too few arguments.\n", sp, args);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  pop_n_elems(args-1); tmp=sp[-1]; switch(tmp.type) { case T_OBJECT: tmp.u.object=tmp.u.object->prev; break; case T_ARRAY: tmp.u.array=tmp.u.array->prev; break; case T_MAPPING: tmp.u.mapping=tmp.u.mapping->prev; break; case T_MULTISET:tmp.u.multiset=tmp.u.multiset->prev; break; case T_PROGRAM: tmp.u.program=tmp.u.program->prev; break; default:
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("_prev", "Bad argument 1.\n", sp, args);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  } if(tmp.u.refs) { assign_svalue(sp-1,&tmp); }else{ pop_stack(); push_int(0); } }
6023ae1997-01-18Fredrik Hübinette (Hubbe) void f__refs(INT32 args) { INT32 i;
aa366d1998-04-16Fredrik Hübinette (Hubbe)  if(!args) PIKE_ERROR("_refs", "Too few arguments.\n", sp, args);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  if(sp[-args].type > MAX_REF_TYPE)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("refs", "Bad argument 1.\n", sp, args);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  i=sp[-args].u.refs[0]; pop_n_elems(args); push_int(i); }
4fbfe21998-12-21Fredrik Hübinette (Hubbe) void f__typeof(INT32 args) { INT32 i; struct pike_string *s,*t; if(!args) PIKE_ERROR("_typeof", "Too few arguments.\n", sp, args); low_init_threads_disable(); s=get_type_of_svalue(sp-args); t=describe_type(s); exit_threads_disable(NULL); free_string(s); pop_n_elems(args); push_string(t); }
6023ae1997-01-18Fredrik Hübinette (Hubbe) void f_replace_master(INT32 args) {
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("replace_master: permission denied.\n"));
6023ae1997-01-18Fredrik Hübinette (Hubbe)  if(!args)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("replace_master", "Too few arguments.\n", sp, 0);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_OBJECT)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("replace_master", "Bad argument 1.\n", sp, args);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  if(!sp[-args].u.object->prog)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("replace_master", "Called with destructed object.\n", sp, args);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  free_object(master_object); master_object=sp[-args].u.object;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(master_object);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  free_program(master_program); master_program=master_object->prog;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(master_program);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  pop_n_elems(args); }
41e4341997-09-06Henrik Grubbström (Grubba) void f_master(INT32 args) { pop_n_elems(args);
164e371998-05-13Fredrik Hübinette (Hubbe)  ref_push_object(master());
41e4341997-09-06Henrik Grubbström (Grubba) }
9548a81997-05-07Per Hedbor #ifdef HAVE_GETHRVTIME #include <sys/time.h> void f_gethrvtime(INT32 args) { pop_n_elems(args);
65d4ed1997-11-02Henrik Grubbström (Grubba)  push_int((INT32)(gethrvtime()/1000));
9548a81997-05-07Per Hedbor } void f_gethrtime(INT32 args) { pop_n_elems(args);
67a5771998-03-12Per Hedbor  if(args) push_int((INT32)(gethrtime())); else push_int((INT32)(gethrtime()/1000));
9548a81997-05-07Per Hedbor }
69b5a61998-02-10Per Hedbor #else void f_gethrtime(INT32 args) { struct timeval tv; pop_n_elems(args); GETTIMEOFDAY(&tv);
67a5771998-03-12Per Hedbor  if(args) push_int((INT32)((tv.tv_sec *1000000) + tv.tv_usec)*1000); else push_int((INT32)((tv.tv_sec *1000000) + tv.tv_usec));
69b5a61998-02-10Per Hedbor }
0dbc6f1997-11-02Henrik Grubbström (Grubba) #endif /* HAVE_GETHRVTIME */
9548a81997-05-07Per Hedbor 
44c89f1997-08-27Henrik Grubbström (Grubba) #ifdef PROFILING static void f_get_prof_info(INT32 args) {
a2a8801998-03-18Per Hedbor  struct program *prog = 0;
44c89f1997-08-27Henrik Grubbström (Grubba)  int num_functions; int i; if (!args) {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("get_profiling_info", "Too few arguments.\n", sp, args);
44c89f1997-08-27Henrik Grubbström (Grubba)  }
1b77121998-03-20Per Hedbor  prog = program_from_svalue(sp-args);
aa366d1998-04-16Fredrik Hübinette (Hubbe)  if(!prog) PIKE_ERROR("get_profiling_info", "Bad argument 1.\n", sp, args);
a2a8801998-03-18Per Hedbor 
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(prog);
44c89f1997-08-27Henrik Grubbström (Grubba)  pop_n_elems(args); /* ({ num_clones, ([ "fun_name":({ num_calls }) ]) }) */ push_int(prog->num_clones);
1dfed21997-11-02Henrik Grubbström (Grubba)  for(num_functions=i=0; i<(int)prog->num_identifiers; i++) {
a2a8801998-03-18Per Hedbor  if (prog->identifiers[i].num_calls) {
44c89f1997-08-27Henrik Grubbström (Grubba)  num_functions++;
0e88611998-04-16Fredrik Hübinette (Hubbe)  add_ref(prog->identifiers[i].name);
44c89f1997-08-27Henrik Grubbström (Grubba)  push_string(prog->identifiers[i].name); push_int(prog->identifiers[i].num_calls);
a2a8801998-03-18Per Hedbor  push_int(prog->identifiers[i].total_time);
6189631998-11-12Fredrik Hübinette (Hubbe)  push_int(prog->identifiers[i].self_time); f_aggregate(3);
44c89f1997-08-27Henrik Grubbström (Grubba)  } } f_aggregate_mapping(num_functions * 2); f_aggregate(2); } #endif /* PROFILING */
ef5b9e1997-10-07Fredrik Hübinette (Hubbe) void f_object_variablep(INT32 args) { struct object *o; struct pike_string *s; int ret; get_all_args("variablep",args,"%o%S",&o, &s); if(!o->prog)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  PIKE_ERROR("variablep", "Called on destructed object.\n", sp, args);
ef5b9e1997-10-07Fredrik Hübinette (Hubbe)  ret=find_shared_string_identifier(s,o->prog); if(ret!=-1) { ret=IDENTIFIER_IS_VARIABLE(ID_FROM_INT(o->prog, ret)->identifier_flags); }else{ ret=0; } pop_n_elems(args); push_int(!!ret); }
f7aff61998-04-14Henrik Wallin  void f_splice(INT32 args) { struct array *out;
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  INT32 size=0x7fffffff; INT32 i,j,k;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
f7aff61998-04-14Henrik Wallin  if(args < 0) fatal("Negative args to f_splice()\n"); #endif
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  for(i=0;i<args;i++) if (sp[i-args].type!=T_ARRAY)
cca11d1998-04-15Henrik Wallin  error("Illegal argument %d to splice.\n", (i+1));
f7aff61998-04-14Henrik Wallin  else
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  if (sp[i-args].u.array->size < size) size=sp[i-args].u.array->size;
f7aff61998-04-14Henrik Wallin 
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  out=allocate_array(args * size);
f7aff61998-04-14Henrik Wallin  if (!args) { push_array(out); return; }
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  out->type_field=0; for(i=-args; i<0; i++) out->type_field|=sp[i].u.array->type_field;
f7aff61998-04-14Henrik Wallin 
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  for(k=j=0; j<size; j++)
f7aff61998-04-14Henrik Wallin  for(i=-args; i<0; i++)
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  assign_svalue_no_free(out->item+(k++), sp[i].u.array->item+j);
f7aff61998-04-14Henrik Wallin  pop_n_elems(args); push_array(out); return; } void f_everynth(INT32 args) {
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  INT32 k,n=2;
f7aff61998-04-14Henrik Wallin  INT32 start=0; struct array *a; struct array *ina; INT32 size=0;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
f7aff61998-04-14Henrik Wallin  if(args < 0) fatal("Negative args to f_everynth()\n"); #endif
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  check_all_args("everynth",args, BIT_ARRAY, BIT_INT | BIT_VOID, BIT_INT | BIT_VOID , 0); switch(args)
f7aff61998-04-14Henrik Wallin  {
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  default: case 3: start=sp[2-args].u.integer;
1e795f1998-07-22Henrik Wallin  if(start<0) error("Third argument to everynth is negative.\n");
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  case 2:
f7aff61998-04-14Henrik Wallin  n=sp[1-args].u.integer;
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  if(n<1) error("Second argument to everynth is negative.\n"); case 1: ina=sp[-args].u.array;
f7aff61998-04-14Henrik Wallin  }
47dd8f1998-04-14Fredrik Hübinette (Hubbe) 
f7aff61998-04-14Henrik Wallin  a=allocate_array(((size=ina->size)-start+n-1)/n);
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  for(k=0; start<size; start+=n) assign_svalue_no_free(a->item+(k++), ina->item+start);
f7aff61998-04-14Henrik Wallin  a->type_field=ina->type_field;
32fd451998-07-16David Hedbor  pop_n_elems(args);
f7aff61998-04-14Henrik Wallin  push_array(a); return; } void f_transpose(INT32 args) { struct array *out; struct array *in; struct array *outinner; struct array *ininner; INT32 sizeininner=0,sizein=0; INT32 inner=0;
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  INT32 j,i;
f7aff61998-04-14Henrik Wallin  TYPE_FIELD type=0;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
f7aff61998-04-14Henrik Wallin  if(args < 0) fatal("Negative args to f_transpose()\n"); #endif if (args<1) error("No arguments given to transpose.\n"); if (sp[-args].type!=T_ARRAY) error("Illegal argument 1 to transpose.\n"); in=sp[-args].u.array; sizein=in->size;
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  if(!sizein)
f7aff61998-04-14Henrik Wallin  { pop_n_elems(args); out=allocate_array(0); push_array(out); return; }
5099861998-07-12Martin Stjernholm  if(in->type_field != BIT_ARRAY)
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  { array_fix_type_field(in);
5099861998-07-12Martin Stjernholm  if(!in->type_field || in->type_field & ~BIT_ARRAY)
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  error("The array given as argument 1 to transpose must contain arrays only.\n"); } sizeininner=in->item->u.array->size;
f7aff61998-04-14Henrik Wallin  for(i=1 ; i<sizein; i++)
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  if (sizeininner!=(in->item+i)->u.array->size) error("The array given as argument 1 to transpose must contain arrays of the same size.\n");
f7aff61998-04-14Henrik Wallin  out=allocate_array(sizeininner); for(i=0; i<sizein; i++)
4c3d391999-01-15Fredrik Hübinette (Hubbe)  type|=in->item[i].u.array->type_field;
f7aff61998-04-14Henrik Wallin 
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  for(j=0; j<sizeininner; j++)
f7aff61998-04-14Henrik Wallin  { struct svalue * ett; struct svalue * tva;
47dd8f1998-04-14Fredrik Hübinette (Hubbe) 
f7aff61998-04-14Henrik Wallin  outinner=allocate_array(sizein); ett=outinner->item; tva=in->item; for(i=0; i<sizein; i++)
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  assign_svalue_no_free(ett+i, tva[i].u.array->item+j); outinner->type_field=type;
5ece8d1998-04-14Henrik Wallin  out->item[j].u.array=outinner;
f7aff61998-04-14Henrik Wallin  out->item[j].type=T_ARRAY; }
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  out->type_field=BIT_ARRAY;
f7aff61998-04-14Henrik Wallin  pop_n_elems(args); push_array(out); return; }
0e88611998-04-16Fredrik Hübinette (Hubbe) #ifdef DEBUG_MALLOC void f__reset_dmalloc(INT32 args) {
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("replace_master: permission denied.\n"));
0e88611998-04-16Fredrik Hübinette (Hubbe)  pop_n_elems(args); reset_debug_malloc(); } #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
8af3901998-04-27Fredrik Hübinette (Hubbe) void f__locate_references(INT32 args) {
4c3d391999-01-15Fredrik Hübinette (Hubbe)  CHECK_SECURITY(0,SECURITY_BIT_SECURITY, ("replace_master: permission denied.\n"));
8af3901998-04-27Fredrik Hübinette (Hubbe)  if(args) locate_references(sp[-args].u.refs); pop_n_elems(args-1); } #endif
f532d81998-09-18Fredrik Hübinette (Hubbe) void f_map_array(INT32 args) { ONERROR tmp; INT32 e; struct svalue *fun; struct array *ret,*foo;
2ff5a51998-09-19Henrik Grubbström (Grubba)  if (args < 2) error("Bad number of arguments to " "map_array(array, function, mixed ...).\n");
f532d81998-09-18Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_ARRAY) error("Bad argument 1 to map_array().\n"); foo=sp[-args].u.array; fun=sp-args+1; ret=allocate_array(foo->size); SET_ONERROR(tmp, do_free_array, ret); for(e=0;e<foo->size;e++) { push_svalue(foo->item+e); assign_svalues_no_free(sp,fun+1,args-2,-1); sp+=args-2; apply_svalue(fun,args-1); ret->item[e]=*(--sp); } pop_n_elems(args); UNSET_ONERROR(tmp); push_array(ret); }
be478c1997-08-30Henrik Grubbström (Grubba) void init_builtin_efuns(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
67a5771998-03-12Per Hedbor  add_efun("gethrtime", f_gethrtime,"function(int|void:int)", OPT_EXTERNAL_DEPEND);
69b5a61998-02-10Per Hedbor 
9548a81997-05-07Per Hedbor #ifdef HAVE_GETHRVTIME add_efun("gethrvtime",f_gethrvtime,"function(void:int)",OPT_EXTERNAL_DEPEND); #endif
3beb891996-06-21Fredrik Hübinette (Hubbe) 
44c89f1997-08-27Henrik Grubbström (Grubba) #ifdef PROFILING add_efun("get_profiling_info", f_get_prof_info, "function(program:array)", OPT_EXTERNAL_DEPEND); #endif /* PROFILING */
591c0c1997-01-19Fredrik Hübinette (Hubbe)  add_efun("_refs",f__refs,"function(function|string|array|mapping|multiset|object|program:int)",OPT_EXTERNAL_DEPEND);
4fbfe21998-12-21Fredrik Hübinette (Hubbe)  add_efun("_typeof",f__typeof,"function(mixed:string)",0);
6023ae1997-01-18Fredrik Hübinette (Hubbe)  add_efun("replace_master",f_replace_master,"function(object:void)",OPT_SIDE_EFFECT);
8987841997-09-09Fredrik Hübinette (Hubbe)  add_efun("master",f_master,"function(:object)",OPT_EXTERNAL_DEPEND);
06983f1996-09-22Fredrik Hübinette (Hubbe)  add_efun("add_constant",f_add_constant,"function(string,void|mixed:void)",OPT_SIDE_EFFECT);
9e52381998-03-01Fredrik Hübinette (Hubbe)  add_efun("aggregate",f_aggregate,"function(0=mixed ...:array(0))",OPT_TRY_OPTIMIZE); add_efun("aggregate_multiset",f_aggregate_multiset,"function(0=mixed ...:multiset(0))",OPT_TRY_OPTIMIZE); add_efun("aggregate_mapping",f_aggregate_mapping,"function(0=mixed ...:mapping(0:0))",OPT_TRY_OPTIMIZE);
06983f1996-09-22Fredrik Hübinette (Hubbe)  add_efun("all_constants",f_all_constants,"function(:mapping(string:mixed))",OPT_EXTERNAL_DEPEND);
a946c71998-03-02Fredrik Hübinette (Hubbe)  add_efun("allocate", f_allocate, "function(int,void|0=mixed:array(0))", 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("arrayp", f_arrayp, "function(mixed:int)",0);
3beb891996-06-21Fredrik Hübinette (Hubbe)  add_efun("backtrace",f_backtrace,"function(:array(array(function|int|string)))",OPT_EXTERNAL_DEPEND);
d2c6081996-11-07Fredrik Hübinette (Hubbe) 
3beb891996-06-21Fredrik Hübinette (Hubbe)  add_efun("column",f_column,"function(array,mixed:array)",0);
05459a1998-04-09Fredrik Hübinette (Hubbe)  add_efun("combine_path",f_combine_path,"function(string...:string)",0);
f532d81998-09-18Fredrik Hübinette (Hubbe)  add_efun("compile",f_compile,"function(string,mixed...:program)",OPT_EXTERNAL_DEPEND);
9e52381998-03-01Fredrik Hübinette (Hubbe)  add_efun("copy_value",f_copy_value,"function(1=mixed:1)",0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("crypt",f_crypt,"function(string:string)|function(string,string:int)",OPT_EXTERNAL_DEPEND); add_efun("ctime",f_ctime,"function(int:string)",OPT_TRY_OPTIMIZE); add_efun("destruct",f_destruct,"function(object|void:void)",OPT_SIDE_EFFECT); add_efun("equal",f_equal,"function(mixed,mixed:int)",OPT_TRY_OPTIMIZE);
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  add_function("everynth",f_everynth,"function(array(0=mixed),int|void,int|void:array(0))", 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("exit",f_exit,"function(int:void)",OPT_SIDE_EFFECT);
608d731998-03-20Fredrik Hübinette (Hubbe)  add_efun("_exit",f__exit,"function(int:void)",OPT_SIDE_EFFECT);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("floatp", f_floatp, "function(mixed:int)",OPT_TRY_OPTIMIZE); add_efun("function_name",f_function_name,"function(function:string)",OPT_TRY_OPTIMIZE); add_efun("function_object",f_function_object,"function(function:object)",OPT_TRY_OPTIMIZE); add_efun("functionp", f_functionp, "function(mixed:int)",OPT_TRY_OPTIMIZE);
3beb891996-06-21Fredrik Hübinette (Hubbe)  add_efun("glob",f_glob,"function(string,string:int)|function(string,string*:array(string))",OPT_TRY_OPTIMIZE);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("hash",f_hash,"function(string,int|void:int)",OPT_TRY_OPTIMIZE);
fa31451998-05-25Henrik Grubbström (Grubba)  add_efun("indices",f_indices,"function(string|array:int*)|function(mapping(1=mixed:mixed)|multiset(1=mixed):array(1))|function(object|program:string*)",0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("intp", f_intp, "function(mixed:int)",OPT_TRY_OPTIMIZE);
06983f1996-09-22Fredrik Hübinette (Hubbe)  add_efun("multisetp", f_multisetp, "function(mixed:int)",OPT_TRY_OPTIMIZE);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("lower_case",f_lower_case,"function(string:string)",OPT_TRY_OPTIMIZE);
9e52381998-03-01Fredrik Hübinette (Hubbe)  add_efun("m_delete",f_m_delete,"function(0=mapping,mixed:0)",0);
3beb891996-06-21Fredrik Hübinette (Hubbe)  add_efun("mappingp",f_mappingp,"function(mixed:int)",OPT_TRY_OPTIMIZE);
9e52381998-03-01Fredrik Hübinette (Hubbe)  add_efun("mkmapping",f_mkmapping,"function(array(1=mixed),array(2=mixed):mapping(1:2))",OPT_TRY_OPTIMIZE);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("next_object",f_next_object,"function(void|object:object)",OPT_EXTERNAL_DEPEND);
8e9fdf1996-12-04Fredrik Hübinette (Hubbe)  add_efun("_next",f__next,"function(string:string)|function(object:object)|function(mapping:mapping)|function(multiset:multiset)|function(program:program)|function(array:array)",OPT_EXTERNAL_DEPEND); add_efun("_prev",f__prev,"function(object:object)|function(mapping:mapping)|function(multiset:multiset)|function(program:program)|function(array:array)",OPT_EXTERNAL_DEPEND);
1b601b1996-11-26Fredrik Hübinette (Hubbe)  add_efun("object_program",f_object_program,"function(mixed:program)",0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("objectp", f_objectp, "function(mixed:int)",0); add_efun("programp",f_programp,"function(mixed:int)",0); add_efun("query_num_arg",f_query_num_arg,"function(:int)",OPT_EXTERNAL_DEPEND); add_efun("random",f_random,"function(int:int)",OPT_EXTERNAL_DEPEND);
cb22561995-10-11Fredrik Hübinette (Hubbe)  add_efun("random_seed",f_random_seed,"function(int:void)",OPT_SIDE_EFFECT);
9e52381998-03-01Fredrik Hübinette (Hubbe)  add_efun("replace",f_replace,"function(string,string,string:string)|function(string,string*,string*:string)|function(0=array,mixed,mixed:0)|function(1=mapping,mixed,mixed:1)",0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("reverse",f_reverse,"function(int:int)|function(string:string)|function(array:array)",0);
3beb891996-06-21Fredrik Hübinette (Hubbe)  add_efun("rows",f_rows,"function(mixed,array:array)",0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("rusage", f_rusage, "function(:int *)",OPT_EXTERNAL_DEPEND); add_efun("search",f_search,"function(string,string,void|int:int)|function(array,mixed,void|int:int)|function(mapping,mixed:mixed)",0);
89b0721998-05-05Fredrik Hübinette (Hubbe)  add_efun("sleep", f_sleep, "function(float|int,int|void:void)",OPT_SIDE_EFFECT);
9e52381998-03-01Fredrik Hübinette (Hubbe)  add_efun("sort",f_sort,"function(array(0=mixed),array(mixed)...:array(0))",OPT_SIDE_EFFECT);
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  add_function("splice",f_splice,"function(array(0=mixed)...:array(0))", 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("stringp", f_stringp, "function(mixed:int)",0); add_efun("this_object", f_this_object, "function(:object)",OPT_EXTERNAL_DEPEND);
e82b301997-01-29Fredrik Hübinette (Hubbe)  add_efun("throw",f_throw,"function(mixed:void)",OPT_SIDE_EFFECT);
d0e6741998-07-15Fredrik Hübinette (Hubbe)  add_efun("time",f_time,"function(void|int:int|float)",OPT_EXTERNAL_DEPEND);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("trace",f_trace,"function(int:int)",OPT_SIDE_EFFECT);
47dd8f1998-04-14Fredrik Hübinette (Hubbe)  add_function("transpose",f_transpose,"function(array(0=mixed):array(0))", 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  add_efun("upper_case",f_upper_case,"function(string:string)",0);
fa31451998-05-25Henrik Grubbström (Grubba)  add_efun("values",f_values,"function(string|multiset:array(int))|function(array(0=mixed)|mapping(mixed:0=mixed)|object|program:array(0))",0);
1b601b1996-11-26Fredrik Hübinette (Hubbe)  add_efun("zero_type",f_zero_type,"function(mixed:int)",0);
53842a1998-04-15Fredrik Hübinette (Hubbe)  add_efun("array_sscanf",f_sscanf,"function(string,string:array)",0);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
4643ea1998-10-10Henrik Grubbström (Grubba)  /* Some Wide-string stuff */ add_efun("string_to_unicode", f_string_to_unicode, "function(string:string)", OPT_TRY_OPTIMIZE); add_efun("unicode_to_string", f_unicode_to_string, "function(string:string)", OPT_TRY_OPTIMIZE);
be40771998-10-15Henrik Grubbström (Grubba)  add_efun("string_to_utf8", f_string_to_utf8, "function(string,int|void:string)", OPT_TRY_OPTIMIZE);
ed65901998-10-31Henrik Grubbström (Grubba)  add_efun("utf8_to_string", f_utf8_to_string, "function(string,int|void:string)", OPT_TRY_OPTIMIZE);
4643ea1998-10-10Henrik Grubbström (Grubba) 
3beb891996-06-21Fredrik Hübinette (Hubbe) #ifdef HAVE_LOCALTIME add_efun("localtime",f_localtime,"function(int:mapping(string:int))",OPT_EXTERNAL_DEPEND);
ed70b71996-06-09Fredrik Hübinette (Hubbe) #endif
2d04c81998-07-28Fredrik Hübinette (Hubbe) #ifdef HAVE_GMTIME
fe91501998-07-26Peter J. Holzer  add_efun("gmtime",f_gmtime,"function(int:mapping(string:int))",OPT_EXTERNAL_DEPEND); #endif
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) #ifdef HAVE_MKTIME
5db18e1998-05-07Fredrik Hübinette (Hubbe)  add_efun("mktime",f_mktime,"function(int,int,int,int,int,int,int,void|int:int)|function(object|mapping:int)",OPT_TRY_OPTIMIZE);
b5d2dc1997-01-27Fredrik Hübinette (Hubbe) #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
3beb891996-06-21Fredrik Hübinette (Hubbe)  add_efun("_verify_internals",f__verify_internals,"function(:void)",OPT_SIDE_EFFECT|OPT_EXTERNAL_DEPEND);
a03d951997-10-14Fredrik Hübinette (Hubbe)  add_efun("_debug",f__debug,"function(int:int)",OPT_SIDE_EFFECT|OPT_EXTERNAL_DEPEND);
2f54f71998-04-13Henrik Grubbström (Grubba) #ifdef YYDEBUG add_efun("_compiler_trace",f__compiler_trace,"function(int:int)",OPT_SIDE_EFFECT|OPT_EXTERNAL_DEPEND); #endif /* YYDEBUG */
ed70b71996-06-09Fredrik Hübinette (Hubbe) #endif
c3c7031996-12-04Fredrik Hübinette (Hubbe)  add_efun("_memory_usage",f__memory_usage,"function(:mapping(string:int))",OPT_EXTERNAL_DEPEND);
ed70b71996-06-09Fredrik Hübinette (Hubbe) 
3beb891996-06-21Fredrik Hübinette (Hubbe)  add_efun("gc",f_gc,"function(:int)",OPT_SIDE_EFFECT);
aac0151997-01-26Fredrik Hübinette (Hubbe)  add_efun("version", f_version, "function(:string)", OPT_TRY_OPTIMIZE);
05590d1998-04-23Fredrik Hübinette (Hubbe)  add_efun("encode_value", f_encode_value, "function(mixed,void|object:string)", OPT_TRY_OPTIMIZE); add_efun("decode_value", f_decode_value, "function(string,void|object:mixed)", OPT_TRY_OPTIMIZE);
ef5b9e1997-10-07Fredrik Hübinette (Hubbe)  add_efun("object_variablep", f_object_variablep, "function(object,string:int)", OPT_EXTERNAL_DEPEND);
088e2e1998-02-12Mirar (Pontus Hagland) 
a7759e1998-11-17Henrik Grubbström (Grubba)  add_function("interleave_array",f_interleave_array,"function(array(mapping(int:mixed)):array(int))",OPT_TRY_OPTIMIZE);
088e2e1998-02-12Mirar (Pontus Hagland)  add_function("diff",f_diff,"function(array,array:array(array))",OPT_TRY_OPTIMIZE); add_function("diff_longest_sequence",f_diff_longest_sequence,"function(array,array:array(int))",OPT_TRY_OPTIMIZE);
f873831998-05-19Henrik Grubbström (Grubba)  add_function("diff_dyn_longest_sequence",f_diff_dyn_longest_sequence,"function(array,array:array(int))",OPT_TRY_OPTIMIZE);
088e2e1998-02-12Mirar (Pontus Hagland)  add_function("diff_compare_table",f_diff_compare_table,"function(array,array:array(array))",OPT_TRY_OPTIMIZE);
7ce3a91998-02-12Henrik Grubbström (Grubba)  add_function("longest_ordered_sequence",f_longest_ordered_sequence,"function(array:array(int))",0);
088e2e1998-02-12Mirar (Pontus Hagland)  add_function("sort",f_sort,"function(array(mixed),array(mixed)...:array(mixed))",OPT_SIDE_EFFECT);
0e88611998-04-16Fredrik Hübinette (Hubbe) #ifdef DEBUG_MALLOC add_efun("_reset_dmalloc",f__reset_dmalloc,"function(void:void)",OPT_SIDE_EFFECT); #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
8af3901998-04-27Fredrik Hübinette (Hubbe)  add_efun("_locate_references",f__locate_references,"function(1=mixed:1)",OPT_SIDE_EFFECT); #endif
3beb891996-06-21Fredrik Hübinette (Hubbe) }
5267b71995-08-09Fredrik Hübinette (Hubbe)