Select Git revision
interpret.c
-
Fredrik Hübinette (Hubbe) authored
Rev: src/interpret.c:1.58 Rev: src/program.c:1.49
Fredrik Hübinette (Hubbe) authoredRev: src/interpret.c:1.58 Rev: src/program.c:1.49
interpret.c 43.42 KiB
/*\
||| This file a part of Pike, and is copyright by Fredrik Hubinette
||| Pike is distributed as GPL (General Public License)
||| See the files COPYING and DISCLAIMER for more information.
\*/
#include "global.h"
RCSID("$Id: interpret.c,v 1.58 1998/01/14 07:53:52 hubbe Exp $");
#include "interpret.h"
#include "object.h"
#include "program.h"
#include "svalue.h"
#include "array.h"
#include "mapping.h"
#include "error.h"
#include "language.h"
#include "stralloc.h"
#include "constants.h"
#include "pike_macros.h"
#include "multiset.h"
#include "backend.h"
#include "operators.h"
#include "opcodes.h"
#include "main.h"
#include "lex.h"
#include "builtin_functions.h"
#include "signal_handler.h"
#include "gc.h"
#include "threads.h"
#include "callback.h"
#include "fd_control.h"
#include <fcntl.h>
#include <errno.h>
#ifdef HAVE_MMAP
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef HAVE_SYS_MMAN_H
#include <sys/mman.h>
#endif
#ifdef MAP_NORESERVE
#define USE_MMAP_FOR_STACK
#endif
#endif
/*
* Define the default evaluator stack size, used for just about everything.
*/
#define EVALUATOR_STACK_SIZE 100000
#define TRACE_LEN (100 + t_flag * 10)
/* sp points to first unused value on stack
* (much simpler than letting it point at the last used value.)
*/
struct svalue *sp; /* Current position */
struct svalue *evaluator_stack; /* Start of stack */
int stack_size = EVALUATOR_STACK_SIZE;
int evaluator_stack_malloced = 0;
/* mark stack, used to store markers into the normal stack */
struct svalue **mark_sp; /* Current position */
struct svalue **mark_stack; /* Start of stack */
int mark_stack_malloced = 0;
void push_sp_mark(void){
if(mark_sp == mark_stack + stack_size)
error("No more mark stack!\n");
*mark_sp++=sp;
}
int pop_sp_mark(void)
{
#ifdef DEBUG
if(mark_sp < mark_stack)
fatal("Mark stack underflow!\n");
#endif
return sp - *--mark_sp;
}
struct frame *fp; /* frame pointer */
#ifdef DEBUG
static void gc_check_stack_callback(struct callback *foo, void *bar, void *gazonk)
{
debug_gc_xmark_svalues(evaluator_stack,sp-evaluator_stack-1,"interpreter stack");
}
#endif
void init_interpreter(void)
{
#ifdef USE_MMAP_FOR_STACK
static int fd = -1;
#ifdef DEBUG
static struct callback *spcb;
if(!spcb)
{
spcb=add_gc_callback(gc_check_stack_callback,0,0);
}
#endif
#ifndef MAP_VARIABLE
#define MAP_VARIABLE 0
#endif
#ifndef MAP_PRIVATE
#define MAP_PRIVATE 0
#endif
#ifndef MAP_FAILED
#define MAP_FAILED -1
#endif
#ifndef MAP_ANONYMOUS
#define MAP_ANONYMOUS 0
if(fd == -1)
{
while(1)
{
fd=open("/dev/zero",O_RDONLY);
if(fd >= 0) break;
if(errno != EINTR)
{
evaluator_stack=0;
mark_stack=0;
goto use_malloc;
}
}
/* Don't keep this fd on exec() */
set_close_on_exec(fd, 1);
}
#endif
#define MMALLOC(X,Y) (Y *)mmap(0,X*sizeof(Y),PROT_READ|PROT_WRITE, MAP_NORESERVE | MAP_PRIVATE | MAP_ANONYMOUS, fd, 0)
evaluator_stack_malloced=0;
mark_stack_malloced=0;
evaluator_stack=MMALLOC(stack_size,struct svalue);
mark_stack=MMALLOC(stack_size, struct svalue *);
if((char *)MAP_FAILED == (char *)evaluator_stack) evaluator_stack=0;
if((char *)MAP_FAILED == (char *)mark_stack) mark_stack=0;
#else
evaluator_stack=0;
mark_stack=0;
#endif
use_malloc:
if(!evaluator_stack)
{
evaluator_stack=(struct svalue *)xalloc(stack_size*sizeof(struct svalue));
evaluator_stack_malloced=1;
}
if(!mark_stack)
{
mark_stack=(struct svalue **)xalloc(stack_size*sizeof(struct svalue *));
mark_stack_malloced=1;
}
sp=evaluator_stack;
mark_sp=mark_stack;
fp=0;
}
void check_stack(INT32 size)
{
if(sp - evaluator_stack + size >= stack_size)
error("Stack overflow.\n");
}
void check_mark_stack(INT32 size)
{
if(mark_sp - mark_stack + size >= stack_size)
error("Stack overflow.\n");
}
static int eval_instruction(unsigned char *pc);
/*
* lvalues are stored in two svalues in one of these formats:
* array[index] : { array, index }
* mapping[index] : { mapping, index }
* multiset[index] : { multiset, index }
* object[index] : { object, index }
* local variable : { svalue_pointer, nothing }
* global variable : { svalue_pointer/short_svalue_pointer, nothing }
*/
void lvalue_to_svalue_no_free(struct svalue *to,struct svalue *lval)
{
switch(lval->type)
{
case T_LVALUE:
assign_svalue_no_free(to, lval->u.lval);
break;
case T_SHORT_LVALUE:
assign_from_short_svalue_no_free(to, lval->u.short_lval, lval->subtype);
break;
case T_OBJECT:
object_index_no_free(to, lval->u.object, lval+1);
break;
case T_ARRAY:
simple_array_index_no_free(to, lval->u.array, lval+1);
break;
case T_MAPPING:
mapping_index_no_free(to, lval->u.mapping, lval+1);
break;
case T_MULTISET:
to->type=T_INT;
if(multiset_member(lval->u.multiset,lval+1))
{
to->u.integer=0;
to->subtype=NUMBER_UNDEFINED;
}else{
to->u.integer=0;
to->subtype=NUMBER_NUMBER;
}
break;
default:
if(IS_ZERO(lval))
error("Indexing the NULL value.\n"); /* Per */
else
error("Indexing a basic type.\n");
}
}
void assign_lvalue(struct svalue *lval,struct svalue *from)
{
switch(lval->type)
{
case T_LVALUE:
assign_svalue(lval->u.lval,from);
break;
case T_SHORT_LVALUE:
assign_to_short_svalue(lval->u.short_lval, lval->subtype, from);
break;
case T_OBJECT:
object_set_index(lval->u.object, lval+1, from);
break;
case T_ARRAY:
simple_set_index(lval->u.array, lval+1, from);
break;
case T_MAPPING:
mapping_insert(lval->u.mapping, lval+1, from);
break;
case T_MULTISET:
if(IS_ZERO(from))
multiset_delete(lval->u.multiset, lval+1);
else
multiset_insert(lval->u.multiset, lval+1);
break;
default:
if(IS_ZERO(lval))
error("Indexing the NULL value.\n"); /* Per */
else
error("Indexing a basic type.\n");
}
}
union anything *get_pointer_if_this_type(struct svalue *lval, TYPE_T t)
{ switch(lval->type)
{
case T_LVALUE:
if(lval->u.lval->type == t) return & ( lval->u.lval->u );
return 0;
case T_SHORT_LVALUE:
if(lval->subtype == t) return lval->u.short_lval;
return 0;
case T_OBJECT:
return object_get_item_ptr(lval->u.object,lval+1,t);
case T_ARRAY:
return array_get_item_ptr(lval->u.array,lval+1,t);
case T_MAPPING:
return mapping_get_item_ptr(lval->u.mapping,lval+1,t);
case T_MULTISET: return 0;
default:
if(IS_ZERO(lval))
error("Indexing the NULL value.\n"); /* Per */
else
error("Indexing a basic type.\n");
return 0;
}
}
#ifdef DEBUG
void print_return_value(void)
{
if(t_flag>3)
{
char *s;
int nonblock;
if((nonblock=query_nonblocking(2)))
set_nonblocking(2,0);
init_buf();
describe_svalue(sp-1,0,0);
s=simple_free_buf();
if((long)strlen(s) > (long)TRACE_LEN)
{
s[TRACE_LEN]=0;
s[TRACE_LEN-1]='.';
s[TRACE_LEN-2]='.';
s[TRACE_LEN-2]='.';
}
fprintf(stderr,"- value: %s\n",s);
free(s);
if(nonblock)
set_nonblocking(2,1);
}
}
#else
#define print_return_value()
#endif
void pop_n_elems(INT32 x)
{
#ifdef DEBUG
if(sp - evaluator_stack < x)
fatal("Popping out of stack.\n");
if(x < 0) fatal("Popping negative number of args....\n");#endif
sp-=x;
free_svalues(sp,x,BIT_MIXED);
}
struct callback_list evaluator_callbacks;
#ifdef DEBUG
static char trace_buffer[100];
#define GET_ARG() (backlog[backlogp].arg=(\
instr=prefix,\
prefix=0,\
instr+=EXTRACT_UCHAR(pc++),\
(t_flag>3 ? sprintf(trace_buffer,"- Arg = %ld\n",(long)instr),write_to_stderr(trace_buffer,strlen(trace_buffer)) : 0),\
instr))
#else
#define GET_ARG() (instr=prefix,prefix=0,instr+EXTRACT_UCHAR(pc++))
#endif
#define CASE(X) case (X)-F_OFFSET:
#define DOJUMP() \
do { int tmp; tmp=EXTRACT_INT(pc); pc+=tmp; if(tmp < 0) fast_check_threads_etc(6); }while(0)
#define COMPARISMENT(ID,EXPR) \
CASE(ID); \
instr=EXPR; \
pop_n_elems(2); \
push_int(instr); \
break
#define LOOP(ID, OP1, OP2, OP3, OP4) \
CASE(ID) \
{ \
union anything *i=get_pointer_if_this_type(sp-2, T_INT); \
if(i) \
{ \
OP1 ( i->integer ); \
if(i->integer OP2 sp[-3].u.integer) \
{ \
pc+=EXTRACT_INT(pc); \
fast_check_threads_etc(8); \
}else{ \
pc+=sizeof(INT32); \
} \
}else{ \
lvalue_to_svalue_no_free(sp-2,sp); sp++; \
push_int(1); \
OP3; \
assign_lvalue(sp-3,sp-1); \
if(OP4 ( sp-1, sp-4 )) \
{ \
pc+=EXTRACT_INT(pc); \
fast_check_threads_etc(8); \
}else{ \
pc+=sizeof(INT32); \
} \
pop_stack(); \
} \
break; \
}
#define CJUMP(X,Y) \
CASE(X); \
if(Y(sp-2,sp-1)) { \
DOJUMP(); \
}else{ \
pc+=sizeof(INT32); \} \
pop_n_elems(2); \
break
/*
* reset the stack machine.
*/
void reset_evaluator(void)
{
fp=0;
pop_n_elems(sp - evaluator_stack);
}
#ifdef DEBUG
#define BACKLOG 512
struct backlog
{
INT32 instruction;
INT32 arg;
struct program *program;
unsigned char *pc;
};
struct backlog backlog[BACKLOG];
int backlogp=BACKLOG-1;
void dump_backlog(void)
{
int e;
if(!d_flag || backlogp<0 || backlogp>=BACKLOG)
return;
e=backlogp;
do
{
e++;
if(e>=BACKLOG) e=0;
if(backlog[e].program)
{
char *file;
INT32 line;
file=get_line(backlog[e].pc-1,backlog[e].program, &line);
fprintf(stderr,"%s:%ld: %s(%ld)\n",
file,
(long)line,
low_get_f_name(backlog[e].instruction + F_OFFSET, backlog[e].program),
(long)backlog[e].arg);
}
}while(e!=backlogp);
}
#endif
static int o_catch(unsigned char *pc);
static int eval_instruction(unsigned char *pc)
{
unsigned INT32 accumulator=0,instr, prefix=0;
while(1)
{
fp->pc = pc;
instr=EXTRACT_UCHAR(pc++);
#ifdef DEBUG
if(d_flag)
{
#ifdef _REENTRANT if(!mt_trylock(& interpreter_lock))
fatal("Interpreter running unlocked!\n");
#endif
sp[0].type=99; /* an invalid type */
sp[1].type=99;
sp[2].type=99;
sp[3].type=99;
if(sp<evaluator_stack || mark_sp < mark_stack || fp->locals>sp)
fatal("Stack error (generic).\n");
if(sp > evaluator_stack+stack_size)
fatal("Stack error (overflow).\n");
if(fp->fun>=0 && fp->current_object->prog &&
fp->locals+fp->num_locals > sp)
fatal("Stack error (stupid!).\n");
if(recoveries && sp-evaluator_stack < recoveries->sp)
fatal("Stack error (underflow)\n");
if(d_flag > 9) do_debug();
backlogp++;
if(backlogp >= BACKLOG) backlogp=0;
if(backlog[backlogp].program)
free_program(backlog[backlogp].program);
backlog[backlogp].program=fp->context.prog;
fp->context.prog->refs++;
backlog[backlogp].instruction=instr;
backlog[backlogp].arg=0;
backlog[backlogp].pc=pc;
}
if(t_flag > 2)
{
char *file, *f;
INT32 linep, nonblock;
if((nonblock=query_nonblocking(2)))
set_nonblocking(2,0);
file=get_line(pc-1,fp->context.prog,&linep);
while((f=STRCHR(file,'/'))) file=f+1;
fprintf(stderr,"- %s:%4ld:(%lx): %-25s %4ld %4ld\n",
file,(long)linep,
(long)(pc-fp->context.prog->program-1),
get_f_name(instr + F_OFFSET),
(long)(sp-evaluator_stack),
(long)(mark_sp-mark_stack));
if(nonblock)
set_nonblocking(2,1);
}
if(instr + F_OFFSET < F_MAX_OPCODE)
ADD_RUNNED(instr + F_OFFSET);
#endif
switch(instr)
{
/* Support to allow large arguments */
CASE(F_PREFIX_256); prefix+=256; break;
CASE(F_PREFIX_512); prefix+=512; break;
CASE(F_PREFIX_768); prefix+=768; break;
CASE(F_PREFIX_1024); prefix+=1024; break;
CASE(F_PREFIX_24BITX256);
prefix+=EXTRACT_UCHAR(pc++)<<24;
CASE(F_PREFIX_WORDX256); prefix+=EXTRACT_UCHAR(pc++)<<16;
CASE(F_PREFIX_CHARX256);
prefix+=EXTRACT_UCHAR(pc++)<<8;
break;
CASE(F_LDA); accumulator=GET_ARG(); break;
/* Push number */
CASE(F_CONST0); push_int(0); break;
CASE(F_CONST1); push_int(1); break;
CASE(F_CONST_1); push_int(-1); break;
CASE(F_BIGNUM); push_int(0x7fffffff); break;
CASE(F_NUMBER); push_int(GET_ARG()); break;
CASE(F_NEG_NUMBER); push_int(-GET_ARG()); break;
/* The rest of the basic 'push value' instructions */
CASE(F_STRING);
copy_shared_string(sp->u.string,fp->context.prog->strings[GET_ARG()]);
sp->type=T_STRING;
sp->subtype=0;
sp++;
print_return_value();
break;
CASE(F_ARROW_STRING);
copy_shared_string(sp->u.string,fp->context.prog->strings[GET_ARG()]);
sp->type=T_STRING;
sp->subtype=1; /* Magic */
sp++;
print_return_value();
break;
CASE(F_CONSTANT);
assign_svalue_no_free(sp++,fp->context.prog->constants+GET_ARG());
print_return_value();
break;
CASE(F_FLOAT);
sp->type=T_FLOAT;
MEMCPY((void *)&sp->u.float_number, pc, sizeof(FLOAT_TYPE));
pc+=sizeof(FLOAT_TYPE);
sp++;
break;
CASE(F_LFUN);
sp->u.object=fp->current_object;
fp->current_object->refs++;
sp->subtype=GET_ARG()+fp->context.identifier_level;
sp->type=T_FUNCTION;
sp++;
break;
/* The not so basic 'push value' instructions */
CASE(F_GLOBAL);
low_object_index_no_free(sp,
fp->current_object,
GET_ARG() + fp->context.identifier_level);
sp++;
print_return_value();
break;
CASE(F_EXTERNAL);
{
struct inherit *inherit;
struct program *p;
INT32 id=GET_ARG();
struct object *o=fp->context.parent;
INT32 i=fp->context.parent_identifier;
while(1) {
if(!o)
error("Parent no longer exists\n");
if(!(p=o->prog))
error("Attempting to access variable in destructed object\n");
inherit=INHERIT_FROM_INT(p, i);
if(!accumulator) break;
--accumulator;
if(p->identifier_references[id].inherit_offset==0)
{
i=o->parent_identifier;
o=o->parent;
}else{
i=inherit->parent_identifier;
o=inherit->parent;
}
}
low_object_index_no_free(sp,
o,
id + inherit->identifier_level);
sp++;
print_return_value();
break;
}
CASE(F_EXTERNAL_LVALUE);
{
struct inherit *inherit;
struct program *p;
INT32 id=GET_ARG();
struct object *o=fp->context.parent;
INT32 i=fp->context.parent_identifier;
while(1)
{
if(!o)
error("Parent no longer exists\n");
if(!(p=o->prog))
error("Attempting to access variable in destructed object\n");
inherit=INHERIT_FROM_INT(p, i);
if(!accumulator) break;
accumulator--;
if(p->identifier_references[id].inherit_offset==0)
{
i=o->parent_identifier;
o=o->parent;
}else{
i=inherit->parent_identifier;
o=inherit->parent;
}
}
ref_push_object(o);
sp->type=T_LVALUE;
sp->u.integer=id + inherit->identifier_level;
sp++;
break;
}
CASE(F_MARK_AND_LOCAL); *(mark_sp++)=sp; CASE(F_LOCAL);
assign_svalue_no_free(sp++,fp->locals+GET_ARG());
print_return_value();
break;
CASE(F_2_LOCALS);
assign_svalue_no_free(sp++,fp->locals+GET_ARG());
print_return_value();
assign_svalue_no_free(sp++,fp->locals+GET_ARG());
print_return_value();
break;
CASE(F_LOCAL_LVALUE);
sp[0].type=T_LVALUE;
sp[0].u.lval=fp->locals+GET_ARG();
sp[1].type=T_VOID;
sp+=2;
break;
CASE(F_CLEAR_2_LOCAL);
instr=GET_ARG();
free_svalues(fp->locals + instr, 2, -1);
fp->locals[instr].type=T_INT;
fp->locals[instr].subtype=0;
fp->locals[instr].u.integer=0;
fp->locals[instr+1].type=T_INT;
fp->locals[instr+1].subtype=0;
fp->locals[instr+1].u.integer=0;
break;
CASE(F_CLEAR_LOCAL);
instr=GET_ARG();
free_svalue(fp->locals + instr);
fp->locals[instr].type=T_INT;
fp->locals[instr].subtype=0;
fp->locals[instr].u.integer=0;
break;
CASE(F_INC_LOCAL);
instr=GET_ARG();
if(fp->locals[instr].type == T_INT)
{
fp->locals[instr].u.integer++;
assign_svalue_no_free(sp++,fp->locals+instr);
}else{
assign_svalue_no_free(sp++,fp->locals+instr);
push_int(1);
f_add(2);
assign_svalue(fp->locals+instr,sp-1);
}
break;
CASE(F_POST_INC_LOCAL);
instr=GET_ARG();
assign_svalue_no_free(sp++,fp->locals+instr);
goto inc_local_and_pop;
CASE(F_INC_LOCAL_AND_POP);
instr=GET_ARG();
inc_local_and_pop:
if(fp->locals[instr].type == T_INT)
{
fp->locals[instr].u.integer++;
}else{
assign_svalue_no_free(sp++,fp->locals+instr);
push_int(1);
f_add(2);
assign_svalue(fp->locals+instr,sp-1);
pop_stack(); }
break;
CASE(F_DEC_LOCAL);
instr=GET_ARG();
if(fp->locals[instr].type == T_INT)
{
fp->locals[instr].u.integer--;
assign_svalue_no_free(sp++,fp->locals+instr);
}else{
assign_svalue_no_free(sp++,fp->locals+instr);
push_int(1);
o_subtract();
assign_svalue(fp->locals+instr,sp-1);
}
break;
CASE(F_POST_DEC_LOCAL);
instr=GET_ARG();
assign_svalue_no_free(sp++,fp->locals+instr);
goto dec_local_and_pop;
/* fp->locals[instr].u.integer--; */
break;
CASE(F_DEC_LOCAL_AND_POP);
instr=GET_ARG();
dec_local_and_pop:
if(fp->locals[instr].type == T_INT)
{
fp->locals[instr].u.integer--;
}else{
assign_svalue_no_free(sp++,fp->locals+instr);
push_int(1);
o_subtract();
assign_svalue(fp->locals+instr,sp-1);
pop_stack();
}
break;
CASE(F_LTOSVAL);
lvalue_to_svalue_no_free(sp,sp-2);
sp++;
break;
CASE(F_LTOSVAL2);
sp[0]=sp[-1];
lvalue_to_svalue_no_free(sp-1,sp-3);
/* this is so that foo+=bar (and similar things) will be faster, this
* is done by freeing the old reference to foo after it has been pushed
* on the stack. That way foo can have only 1 reference if we are lucky,
* and then the low array/multiset/mapping manipulation routines can be
* destructive if they like
*/
if( (1 << sp[-1].type) & ( BIT_ARRAY | BIT_MULTISET | BIT_MAPPING | BIT_STRING ))
{
struct svalue s;
s.type=T_INT;
s.subtype=0;
s.u.integer=0;
assign_lvalue(sp-3,&s);
}
sp++;
break;
CASE(F_ADD_TO_AND_POP);
sp[0]=sp[-1];
lvalue_to_svalue_no_free(sp-1,sp-3);
/* this is so that foo+=bar (and similar things) will be faster, this
* is done by freeing the old reference to foo after it has been pushed
* on the stack. That way foo can have only 1 reference if we are lucky,
* and then the low array/multiset/mapping manipulation routines can be
* destructive if they like
*/
if( (1 << sp[-1].type) & ( BIT_ARRAY | BIT_MULTISET | BIT_MAPPING | BIT_STRING ))
{
struct svalue s;
s.type=T_INT;
s.subtype=0;
s.u.integer=0;
assign_lvalue(sp-3,&s);
}
sp++;
f_add(2);
assign_lvalue(sp-3,sp-1);
pop_n_elems(3);
break;
CASE(F_GLOBAL_LVALUE)
{
struct identifier *i;
INT32 tmp=GET_ARG() + fp->context.identifier_level;
if(!fp->current_object->prog)
error("Cannot access global variables in destructed object.\n");
i=ID_FROM_INT(fp->current_object->prog, tmp);
if(!IDENTIFIER_IS_VARIABLE(i->identifier_flags))
error("Cannot re-assign functions or constants.\n");
if(i->run_time_type == T_MIXED)
{
sp[0].type=T_LVALUE;
sp[0].u.lval=(struct svalue *)GLOBAL_FROM_INT(tmp);
}else{
sp[0].type=T_SHORT_LVALUE;
sp[0].u.short_lval= (union anything *)GLOBAL_FROM_INT(tmp);
sp[0].subtype=i->run_time_type;
}
sp[1].type=T_VOID;
sp+=2;
break;
}
CASE(F_INC);
{
union anything *u=get_pointer_if_this_type(sp-2, T_INT);
if(u)
{
instr=++ u->integer;
pop_n_elems(2);
push_int(u->integer);
}else{
lvalue_to_svalue_no_free(sp, sp-2); sp++;
push_int(1);
f_add(2);
assign_lvalue(sp-3, sp-1);
assign_svalue(sp-3, sp-1);
pop_n_elems(2);
}
break;
}
CASE(F_DEC);
{
union anything *u=get_pointer_if_this_type(sp-2, T_INT);
if(u) {
instr=-- u->integer;
pop_n_elems(2);
push_int(u->integer);
}else{
lvalue_to_svalue_no_free(sp, sp-2); sp++;
push_int(1);
o_subtract();
assign_lvalue(sp-3, sp-1);
assign_svalue(sp-3, sp-1);
pop_n_elems(2);
}
break;
}
CASE(F_DEC_AND_POP);
{
union anything *u=get_pointer_if_this_type(sp-2, T_INT);
if(u)
{
instr=-- u->integer;
pop_n_elems(2);
}else{
lvalue_to_svalue_no_free(sp, sp-2); sp++;
push_int(1);
o_subtract();
assign_lvalue(sp-3, sp-1);
pop_n_elems(3);
}
break;
}
CASE(F_INC_AND_POP);
{
union anything *u=get_pointer_if_this_type(sp-2, T_INT);
if(u)
{
instr=++ u->integer;
pop_n_elems(2);
}else{
lvalue_to_svalue_no_free(sp, sp-2); sp++;
push_int(1);
f_add(2);
assign_lvalue(sp-3, sp-1);
pop_n_elems(3);
}
break;
}
CASE(F_POST_INC);
{
union anything *u=get_pointer_if_this_type(sp-2, T_INT);
if(u)
{
instr=u->integer ++;
pop_n_elems(2);
push_int(instr);
}else{
lvalue_to_svalue_no_free(sp, sp-2); sp++;
assign_svalue_no_free(sp,sp-1); sp++;
push_int(1);
f_add(2);
assign_lvalue(sp-4, sp-1);
assign_svalue(sp-4, sp-2);
pop_n_elems(3);
}
break;
}
CASE(F_POST_DEC); {
union anything *u=get_pointer_if_this_type(sp-2, T_INT);
if(u)
{
instr=u->integer --;
pop_n_elems(2);
push_int(instr);
}else{
lvalue_to_svalue_no_free(sp, sp-2); sp++;
assign_svalue_no_free(sp,sp-1); sp++;
push_int(1);
o_subtract();
assign_lvalue(sp-4, sp-1);
assign_svalue(sp-4, sp-2);
pop_n_elems(3);
}
break;
}
CASE(F_ASSIGN);
assign_lvalue(sp-3,sp-1);
free_svalue(sp-3);
free_svalue(sp-2);
sp[-3]=sp[-1];
sp-=2;
break;
CASE(F_ASSIGN_AND_POP);
assign_lvalue(sp-3,sp-1);
pop_n_elems(3);
break;
CASE(F_ASSIGN_LOCAL);
assign_svalue(fp->locals+GET_ARG(),sp-1);
break;
CASE(F_ASSIGN_LOCAL_AND_POP);
instr=GET_ARG();
free_svalue(fp->locals+instr);
fp->locals[instr]=sp[-1];
sp--;
break;
CASE(F_ASSIGN_GLOBAL)
{
struct identifier *i;
INT32 tmp=GET_ARG() + fp->context.identifier_level;
if(!fp->current_object->prog)
error("Cannot access global variables in destructed object.\n");
i=ID_FROM_INT(fp->current_object->prog, tmp);
if(!IDENTIFIER_IS_VARIABLE(i->identifier_flags))
error("Cannot assign functions or constants.\n");
if(i->run_time_type == T_MIXED)
{
assign_svalue((struct svalue *)GLOBAL_FROM_INT(tmp), sp-1);
}else{
assign_to_short_svalue((union anything *)GLOBAL_FROM_INT(tmp),
i->run_time_type,
sp-1);
}
}
break;
CASE(F_ASSIGN_GLOBAL_AND_POP)
{
struct identifier *i;
INT32 tmp=GET_ARG() + fp->context.identifier_level;
if(!fp->current_object->prog)
error("Cannot access global variables in destructed object.\n");
i=ID_FROM_INT(fp->current_object->prog, tmp);
if(!IDENTIFIER_IS_VARIABLE(i->identifier_flags))
error("Cannot assign functions or constants.\n");
if(i->run_time_type == T_MIXED)
{
struct svalue *s=(struct svalue *)GLOBAL_FROM_INT(tmp);
free_svalue(s);
sp--;
*s=*sp;
}else{
assign_to_short_svalue((union anything *)GLOBAL_FROM_INT(tmp),
i->run_time_type,
sp-1);
pop_stack();
}
}
break;
/* Stack machine stuff */
CASE(F_POP_VALUE); pop_stack(); break;
CASE(F_POP_N_ELEMS); pop_n_elems(GET_ARG()); break;
CASE(F_MARK2); *(mark_sp++)=sp;
CASE(F_MARK); *(mark_sp++)=sp; break;
CASE(F_CLEAR_STRING_SUBTYPE);
if(sp[-1].type==T_STRING) sp[-1].subtype=0;
break;
/* Jumps */
CASE(F_BRANCH);
DOJUMP();
break;
CASE(F_BRANCH_WHEN_ZERO);
if(!IS_ZERO(sp-1))
{
pc+=sizeof(INT32);
}else{
DOJUMP();
}
pop_stack();
break;
CASE(F_BRANCH_WHEN_NON_ZERO);
if(IS_ZERO(sp-1))
{
pc+=sizeof(INT32);
}else{
DOJUMP();
}
pop_stack();
break;
CJUMP(F_BRANCH_WHEN_EQ, is_eq);
CJUMP(F_BRANCH_WHEN_NE,!is_eq);
CJUMP(F_BRANCH_WHEN_LT, is_lt);
CJUMP(F_BRANCH_WHEN_LE,!is_gt);
CJUMP(F_BRANCH_WHEN_GT, is_gt);
CJUMP(F_BRANCH_WHEN_GE,!is_lt);
CASE(F_LAND);
if(!IS_ZERO(sp-1))
{
pc+=sizeof(INT32);
pop_stack();
}else{
DOJUMP();
} break;
CASE(F_LOR);
if(IS_ZERO(sp-1))
{
pc+=sizeof(INT32);
pop_stack();
}else{
DOJUMP();
}
break;
CASE(F_EQ_OR);
if(!is_eq(sp-2,sp-1))
{
pop_n_elems(2);
pc+=sizeof(INT32);
}else{
pop_n_elems(2);
push_int(1);
DOJUMP();
}
break;
CASE(F_EQ_AND);
if(is_eq(sp-2,sp-1))
{
pop_n_elems(2);
pc+=sizeof(INT32);
}else{
pop_n_elems(2);
push_int(0);
DOJUMP();
}
break;
CASE(F_CATCH);
if(o_catch(pc+sizeof(INT32)))
return -1; /* There was a return inside the evaluated code */
else
pc+=EXTRACT_INT(pc);
break;
CASE(F_THROW_ZERO);
push_int(0);
f_throw(1);
break;
CASE(F_SWITCH)
{
INT32 tmp;
tmp=switch_lookup(fp->context.prog->
constants[GET_ARG()].u.array,sp-1);
pc=(unsigned char *)DO_ALIGN(pc,sizeof(INT32));
pc+=(tmp>=0 ? 1+tmp*2 : 2*~tmp) * sizeof(INT32);
if(*(INT32*)pc < 0) fast_check_threads_etc(7);
pc+=*(INT32*)pc;
pop_stack();
break;
}
LOOP(F_INC_LOOP, ++, <, f_add(2), is_lt);
LOOP(F_DEC_LOOP, --, >, o_subtract(), is_gt);
LOOP(F_INC_NEQ_LOOP, ++, !=, f_add(2), !is_eq);
LOOP(F_DEC_NEQ_LOOP, --, !=, o_subtract(), !is_eq);
CASE(F_FOREACH) /* array, lvalue , i */
{
if(sp[-4].type != T_ARRAY) error("Bad argument 1 to foreach()\n");
if(sp[-1].u.integer < sp[-4].u.array->size) {
fast_check_threads_etc(10);
index_no_free(sp,sp-4,sp-1);
sp++;
assign_lvalue(sp-4, sp-1);
free_svalue(sp-1);
sp--;
pc+=EXTRACT_INT(pc);
sp[-1].u.integer++;
}else{
pc+=sizeof(INT32);
}
break;
}
CASE(F_APPLY_AND_RETURN);
{
INT32 args=sp - *--mark_sp;
if(fp->locals >= sp-args)
{
MEMMOVE(sp-args+1,sp-args,args*sizeof(struct svalue));
sp++;
sp[-args-1].type=T_INT;
}
/* We sabotage the stack here */
assign_svalue(sp-args-1,fp->context.prog->constants+GET_ARG());
return args+1;
}
CASE(F_CALL_LFUN_AND_RETURN);
{
INT32 args=sp - *--mark_sp;
if(fp->locals >= sp-args)
{
MEMMOVE(sp-args+1,sp-args,args*sizeof(struct svalue));
sp++;
sp[-args-1].type=T_INT;
}else{
free_svalue(sp-args-1);
}
/* More stack sabotage */
sp[-args-1].u.object=fp->current_object;
sp[-args-1].subtype=GET_ARG()+fp->context.identifier_level;
sp[-args-1].type=T_FUNCTION;
fp->current_object->refs++;
return args+1;
}
CASE(F_RETURN_1);
push_int(1);
goto do_return;
CASE(F_RETURN_0);
push_int(0);
goto do_return;
CASE(F_RETURN);
do_return:
#if defined(DEBUG) && defined(GC2)
if(d_flag > 2) do_gc();
check_threads_etc();
#endif
/* fall through */
CASE(F_DUMB_RETURN);
return -1;
CASE(F_NEGATE); if(sp[-1].type == T_INT)
{
sp[-1].u.integer =- sp[-1].u.integer;
}else if(sp[-1].type == T_FLOAT)
{
sp[-1].u.float_number =- sp[-1].u.float_number;
}else{
o_negate();
}
break;
CASE(F_COMPL); o_compl(); break;
CASE(F_NOT);
switch(sp[-1].type)
{
case T_INT:
sp[-1].u.integer =! sp[-1].u.integer;
break;
case T_FUNCTION:
case T_OBJECT:
if(IS_ZERO(sp-1))
{
pop_stack();
push_int(1);
}else{
pop_stack();
push_int(0);
}
break;
default:
free_svalue(sp-1);
sp[-1].type=T_INT;
sp[-1].u.integer=0;
}
break;
CASE(F_LSH); o_lsh(); break;
CASE(F_RSH); o_rsh(); break;
COMPARISMENT(F_EQ, is_eq(sp-2,sp-1));
COMPARISMENT(F_NE,!is_eq(sp-2,sp-1));
COMPARISMENT(F_GT, is_gt(sp-2,sp-1));
COMPARISMENT(F_GE,!is_lt(sp-2,sp-1));
COMPARISMENT(F_LT, is_lt(sp-2,sp-1));
COMPARISMENT(F_LE,!is_gt(sp-2,sp-1));
CASE(F_ADD); f_add(2); break;
CASE(F_SUBTRACT); o_subtract(); break;
CASE(F_AND); o_and(); break;
CASE(F_OR); o_or(); break;
CASE(F_XOR); o_xor(); break;
CASE(F_MULTIPLY); o_multiply(); break;
CASE(F_DIVIDE); o_divide(); break;
CASE(F_MOD); o_mod(); break;
CASE(F_ADD_INT); push_int(GET_ARG()); f_add(2); break;
CASE(F_ADD_NEG_INT); push_int(-GET_ARG()); f_add(2); break;
CASE(F_PUSH_ARRAY);
if(sp[-1].type!=T_ARRAY) error("Bad argument to @\n");
sp--;
push_array_items(sp->u.array);
break;
CASE(F_LOCAL_INDEX);
assign_svalue_no_free(sp++,fp->locals+GET_ARG());
if(sp[-1].type == T_STRING) sp[-1].subtype=0;
print_return_value();
goto do_index;
CASE(F_POS_INT_INDEX);
push_int(GET_ARG());
print_return_value();
goto do_index;
CASE(F_NEG_INT_INDEX);
push_int(-GET_ARG());
print_return_value();
goto do_index;
CASE(F_ARROW);
copy_shared_string(sp->u.string,fp->context.prog->strings[GET_ARG()]);
sp->type=T_STRING;
sp->subtype=1;
sp++;
print_return_value();
goto do_index;
CASE(F_STRING_INDEX);
copy_shared_string(sp->u.string,fp->context.prog->strings[GET_ARG()]);
sp->type=T_STRING;
sp->subtype=0;
sp++;
print_return_value();
/* Fall through */
CASE(F_INDEX);
do_index:
o_index();
print_return_value();
break;
CASE(F_CAST); f_cast(); break;
CASE(F_RANGE); o_range(); break;
CASE(F_COPY_VALUE);
{
struct svalue tmp;
copy_svalues_recursively_no_free(&tmp,sp-1,1,0);
free_svalue(sp-1);
sp[-1]=tmp;
}
break;
CASE(F_SIZEOF);
instr=pike_sizeof(sp-1);
pop_stack();
push_int(instr);
break;
CASE(F_SIZEOF_LOCAL);
push_int(pike_sizeof(fp->locals+GET_ARG()));
break;
CASE(F_SSCANF); f_sscanf(GET_ARG()); break;
CASE(F_CALL_LFUN);
apply_low(fp->current_object,
GET_ARG()+fp->context.identifier_level,
sp - *--mark_sp);
break;
CASE(F_CALL_LFUN_AND_POP);
apply_low(fp->current_object,
GET_ARG()+fp->context.identifier_level,
sp - *--mark_sp); pop_stack();
break;
CASE(F_MARK_APPLY);
strict_apply_svalue(fp->context.prog->constants + GET_ARG(), 0);
break;
CASE(F_MARK_APPLY_POP);
strict_apply_svalue(fp->context.prog->constants + GET_ARG(), 0);
pop_stack();
break;
CASE(F_APPLY);
strict_apply_svalue(fp->context.prog->constants + GET_ARG(), sp - *--mark_sp );
break;
CASE(F_APPLY_AND_POP);
strict_apply_svalue(fp->context.prog->constants + GET_ARG(), sp - *--mark_sp );
pop_stack();
break;
CASE(F_CALL_FUNCTION);
mega_apply(APPLY_STACK,sp - *--mark_sp,0,0);
break;
CASE(F_CALL_FUNCTION_AND_RETURN);
return sp - *--mark_sp;
default:
fatal("Strange instruction %ld\n",(long)instr);
}
}
}
void mega_apply(enum apply_type type, INT32 args, void *arg1, void *arg2)
{
struct object *o;
int fun, tailrecurse=-1;
struct svalue *save_sp=sp-args;
switch(type)
{
case APPLY_STACK:
apply_stack:
if(!args)
error("Too few arguments to `()\n");
args--;
if(sp-save_sp-args > (args<<2) + 32)
{
/* The test above assures these two areas
* are not overlapping
*/
assign_svalues(save_sp, sp-args-1, args+1, BIT_MIXED);
pop_n_elems(sp-save_sp-args-1);
}
arg1=(void *)(sp-args-1);
case APPLY_SVALUE:
apply_svalue:
{
struct svalue *s=(struct svalue *)arg1;
switch(s->type)
{
case T_INT:
if (!s->u.integer) {
error("Attempt to call the NULL-value\n");
} else {
error("Attempt to call the value %d\n", s->u.integer);
}
case T_STRING:
if (s->u.string->len > 20) {
error("Attempt to call the string \"%20s\"...\n", s->u.string->str);
} else {
error("Attempt to call the string \"%s\"\n", s->u.string->str);
}
case T_MAPPING:
error("Attempt to call a mapping\n");
default:
error("Call to non-function value type:%d.\n", s->type);
case T_FUNCTION:
if(s->subtype == FUNCTION_BUILTIN)
{
(*(s->u.efun->function))(args);
break;
}else{
o=s->u.object;
fun=s->subtype;
goto apply_low;
}
break;
case T_ARRAY:
apply_array(s->u.array,args);
break;
case T_PROGRAM:
push_object(clone_object(s->u.program,args));
break;
case T_OBJECT:
o=s->u.object;
fun=LFUN_CALL;
goto call_lfun;
}
break;
}
call_lfun:
#ifdef DEBUG
if(fun < 0 || fun >= NUM_LFUNS)
fatal("Apply lfun on illegal value!\n");
#endif
if(!o->prog)
error("Apply on destructed object.\n");
fun=FIND_LFUN(o->prog,fun);
goto apply_low;
case APPLY_LOW:
o=(struct object *)arg1;
fun=(long)arg2;
apply_low:
{
struct program *p;
struct reference *ref;
struct frame new_frame;
struct identifier *function;
if(fun<0)
{
pop_n_elems(sp-save_sp);
push_int(0);
return;
}
check_threads_etc();
check_stack(256); check_mark_stack(256);
#ifdef DEBUG
if(d_flag>2) do_debug();
#endif
p=o->prog;
if(!p)
error("Cannot call functions in destructed objects.\n");
#ifdef DEBUG
if(fun>=(int)p->num_identifier_references)
fatal("Function index out of range.\n");
#endif
ref = p->identifier_references + fun;
#ifdef DEBUG
if(ref->inherit_offset>=p->num_inherits)
fatal("Inherit offset out of range in program.\n");
#endif
/* init a new evaluation frame */
new_frame.parent_frame = fp;
new_frame.current_object = o;
new_frame.context = p->inherits[ ref->inherit_offset ];
if(!ref->inherit_offset) new_frame.context.parent=o->parent;
function = new_frame.context.prog->identifiers + ref->identifier_offset;
new_frame.locals = sp - args;
new_frame.args = args;
new_frame.fun = fun;
new_frame.current_storage = o->storage+new_frame.context.storage_offset;
new_frame.pc = 0;
new_frame.current_object->refs++;
new_frame.context.prog->refs++;
if(new_frame.context.parent) new_frame.context.parent->refs++;
#ifdef DEBUG
if(t_flag)
{
char *file, *f;
INT32 linep,e,nonblock;
char buf[50],*s;
if((nonblock=query_nonblocking(2)))
set_nonblocking(2,0);
if(fp && fp->pc)
{
file=get_line(fp->pc,fp->context.prog,&linep);
while((f=STRCHR(file,'/'))) file=f+1;
}else{
linep=0;
file="-";
}
init_buf();
sprintf(buf,"%lx->",(long)o);
my_strcat(buf);
my_strcat(function->name->str);
my_strcat("(");
for(e=0;e<args;e++)
{
if(e) my_strcat(",");
describe_svalue(sp-args+e,0,0);
}
my_strcat(")");
s=simple_free_buf();
if((long)strlen(s) > (long)TRACE_LEN) {
s[TRACE_LEN]=0;
s[TRACE_LEN-1]='.';
s[TRACE_LEN-2]='.';
s[TRACE_LEN-2]='.';
}
fprintf(stderr,"- %s:%4ld: %s\n",file,(long)linep,s);
free(s);
if(nonblock)
set_nonblocking(2,1);
}
#endif
fp = &new_frame;
if(function->func.offset == -1)
error("Calling undefined function '%s'.\n",function->name->str);
switch(function->identifier_flags & (IDENTIFIER_FUNCTION | IDENTIFIER_CONSTANT))
{
case IDENTIFIER_C_FUNCTION:
fp->num_args=args;
new_frame.num_locals=args;
(*function->func.c_fun)(args);
break;
case IDENTIFIER_CONSTANT:
{
struct svalue *s=fp->context.prog->constants+function->func.offset;
if(s->type == T_PROGRAM)
{
struct object *tmp=parent_clone_object(s->u.program,
o,
fun,
args);
push_object(tmp);
break;
}
/* Fall through */
}
case 0:
{
if(sp-save_sp-args<=0)
{
/* Create an extra svalue for tail recursion style call */
sp++;
MEMMOVE(sp-args,sp-args-1,sizeof(struct svalue)*args);
sp[-args-1].type=T_INT;
}
low_object_index_no_free(sp-args-1,o,fun);
tailrecurse=args+1;
break;
}
case IDENTIFIER_PIKE_FUNCTION:
{
int num_args;
int num_locals;
unsigned char *pc;
pc=new_frame.context.prog->program + function->func.offset;
num_locals=EXTRACT_UCHAR(pc++);
num_args=EXTRACT_UCHAR(pc++);
/* adjust arguments on stack */
if(args < num_args) /* push zeros */
{
clear_svalues(sp, num_args-args); sp += num_args-args;
args += num_args-args;
}
if(function->identifier_flags & IDENTIFIER_VARARGS)
{
f_aggregate(args - num_args); /* make array */
args = num_args+1;
}else{
if(args > num_args)
{
/* pop excessive */
pop_n_elems(args - num_args);
args=num_args;
}
}
clear_svalues(sp, num_locals - args);
sp += num_locals - args;
#ifdef DEBUG
if(num_locals < num_args)
fatal("Wrong number of arguments or locals in function def.\n");
#endif
new_frame.num_locals=num_locals;
new_frame.num_args=num_args;
tailrecurse=eval_instruction(pc);
#ifdef DEBUG
if(sp<evaluator_stack)
fatal("Stack error (also simple).\n");
#endif
break;
}
}
#if 0
if(sp - new_frame.locals > 1)
{
pop_n_elems(sp - new_frame.locals -1);
}else if(sp - new_frame.locals < 1){
#ifdef DEBUG
if(sp - new_frame.locals<0) fatal("Frame underflow.\n");
#endif
sp->u.integer = 0;
sp->subtype=NUMBER_NUMBER;
sp->type = T_INT;
sp++;
}
#endif
if(new_frame.context.parent) free_object(new_frame.context.parent);
free_object(new_frame.current_object);
free_program(new_frame.context.prog);
fp = new_frame.parent_frame;
if(tailrecurse>=0)
{
args=tailrecurse;
goto apply_stack;
}
#ifdef DEBUG
if(t_flag)
{
char *s;
int nonblock;
if((nonblock=query_nonblocking(2)))
set_nonblocking(2,0);
init_buf();
my_strcat("Return: ");
describe_svalue(sp-1,0,0);
s=simple_free_buf();
if((long)strlen(s) > (long)TRACE_LEN)
{
s[TRACE_LEN]=0;
s[TRACE_LEN-1]='.';
s[TRACE_LEN-2]='.';
s[TRACE_LEN-2]='.';
}
fprintf(stderr,"%-*s%s\n",4,"-",s);
free(s);
if(nonblock)
set_nonblocking(2,1);
}
#endif
}
}
if(save_sp+1 < sp)
{
assign_svalue(save_sp,sp-1);
pop_n_elems(sp-save_sp-1);
}
if(save_sp+1 > sp && type != APPLY_SVALUE)
push_int(0);
}
/* Put catch outside of eval_instruction, so
* the setjmp won't affect the optimization of
* eval_instruction
*/
static int o_catch(unsigned char *pc)
{
JMP_BUF tmp;
if(SETJMP(tmp))
{
*sp=throw_value;
throw_value.type=T_INT;
sp++;
UNSETJMP(tmp);
return 0;
}else{
int x=eval_instruction(pc);
if(x!=-1) mega_apply(APPLY_STACK, x, 0,0);
UNSETJMP(tmp);
return 1;
}
}
int apply_low_safe_and_stupid(struct object *o, INT32 offset)
{
JMP_BUF tmp;
struct frame new_frame;
int ret;
new_frame.parent_frame = fp;
new_frame.current_object = o;
new_frame.context=o->prog->inherits[0];
new_frame.locals = evaluator_stack;
new_frame.args = 0;
new_frame.num_args=0;
new_frame.num_locals=0;
new_frame.fun = -1;
new_frame.pc = 0; new_frame.current_storage=o->storage;
new_frame.context.parent=0;
fp = & new_frame;
new_frame.current_object->refs++;
new_frame.context.prog->refs++;
if(SETJMP(tmp))
{
ret=1;
}else{
int tmp=eval_instruction(o->prog->program + offset);
if(tmp!=-1) mega_apply(APPLY_STACK, tmp, 0,0);
#ifdef DEBUG
if(sp<evaluator_stack)
fatal("Stack error (simple).\n");
#endif
ret=0;
}
UNSETJMP(tmp);
free_object(new_frame.current_object);
free_program(new_frame.context.prog);
fp = new_frame.parent_frame;
return ret;
}
void safe_apply_low(struct object *o,int fun,int args)
{
JMP_BUF recovery;
sp-=args;
free_svalue(& throw_value);
throw_value.type=T_INT;
if(SETJMP(recovery))
{
if(throw_value.type == T_ARRAY)
{
ONERROR tmp;
SET_ONERROR(tmp,exit_on_error,"Error in handle_error in master object!");
assign_svalue_no_free(sp++, & throw_value);
APPLY_MASTER("handle_error", 1);
pop_stack();
UNSET_ONERROR(tmp);
}
sp->u.integer = 0;
sp->subtype=NUMBER_NUMBER;
sp->type = T_INT;
sp++;
}else{
INT32 expected_stack = sp - evaluator_stack + 1;
sp+=args;
apply_low(o,fun,args);
if(sp - evaluator_stack > expected_stack)
pop_n_elems(sp - evaluator_stack - expected_stack);
if(sp - evaluator_stack < expected_stack)
{
sp->u.integer = 0;
sp->subtype=NUMBER_NUMBER;
sp->type = T_INT;
sp++;
}
}
UNSETJMP(recovery);
}
void safe_apply(struct object *o, char *fun ,INT32 args)
{
#ifdef DEBUG
if(!o->prog) fatal("Apply safe on destructed object.\n");
#endif
safe_apply_low(o, find_identifier(fun, o->prog), args);
}
void apply_lfun(struct object *o, int fun, int args)
{
#ifdef DEBUG
if(fun < 0 || fun >= NUM_LFUNS)
fatal("Apply lfun on illegal value!\n");
#endif
if(!o->prog)
error("Apply on destructed object.\n");
apply_low(o, (int)FIND_LFUN(o->prog,fun), args);
}
void apply_shared(struct object *o,
struct pike_string *fun,
int args)
{
apply_low(o, find_shared_string_identifier(fun, o->prog), args);
}
void apply(struct object *o, char *fun, int args)
{
apply_low(o, find_identifier(fun, o->prog), args);
}
void apply_svalue(struct svalue *s, INT32 args)
{
if(s->type==T_INT)
{
pop_n_elems(args);
push_int(0);
}else{
INT32 expected_stack=sp-args+1 - evaluator_stack;
strict_apply_svalue(s,args);
if(sp > (expected_stack + evaluator_stack))
{
pop_n_elems(sp-(expected_stack + evaluator_stack));
}
else if(sp < (expected_stack + evaluator_stack))
{
push_int(0);
}
#ifdef DEBUG
if(sp < (expected_stack + evaluator_stack))
fatal("Stack underflow!\n");
#endif
}
}
#ifdef DEBUG
void slow_check_stack(void)
{
struct svalue *s,**m;
struct frame *f;
debug_check_stack();
if(sp > &(evaluator_stack[stack_size]))
fatal("Stack overflow\n");
if(mark_sp > &(mark_stack[stack_size])) fatal("Mark stack overflow.\n");
if(mark_sp < mark_stack)
fatal("Mark stack underflow.\n");
for(s=evaluator_stack;s<sp;s++) check_svalue(s);
s=evaluator_stack;
for(m=mark_stack;m<mark_sp;m++)
{
if(*m < s)
fatal("Mark stack failiure.\n");
s=*m;
}
if(s > &(evaluator_stack[stack_size]))
fatal("Mark stack exceeds svalue stack\n");
for(f=fp;f;f=f->parent_frame)
{
if(f->locals)
{
if(f->locals < evaluator_stack ||
f->locals > &(evaluator_stack[stack_size]))
fatal("Local variable pointer points to Finspng.\n");
if(f->args < 0 || f->args > stack_size)
fatal("FEL FEL FEL! HELP!! (corrupted frame)\n");
}
}
}
#endif
void cleanup_interpret(void)
{
#ifdef DEBUG
int e;
#endif
while(fp)
{
free_object(fp->current_object);
free_program(fp->context.prog);
fp = fp->parent_frame;
}
#ifdef DEBUG
for(e=0;e<BACKLOG;e++)
{
if(backlog[e].program)
{
free_program(backlog[e].program);
backlog[e].program=0;
}
}
#endif
reset_evaluator();
#ifdef USE_MMAP_FOR_STACK
if(!evaluator_stack_malloced)
{
munmap((char *)evaluator_stack, stack_size*sizeof(struct svalue));
evaluator_stack=0;
}
if(!mark_stack_malloced)
{
munmap((char *)mark_stack, stack_size*sizeof(struct svalue *));
mark_stack=0; }
#endif
if(evaluator_stack) free((char *)evaluator_stack);
if(mark_stack) free((char *)mark_stack);
mark_stack=0;
evaluator_stack=0;
mark_stack_malloced=0;
evaluator_stack_malloced=0;
}