Branch: Tag:

1998-01-13

1998-01-13 23:01:47 by Fredrik Hübinette (Hubbe) <hubbe@hubbe.net>

Compiler update to use two pass

Rev: src/acconfig.h:1.14
Rev: src/builtin_functions.c:1.59
Rev: src/builtin_functions.h:1.5
Rev: src/compilation.h:1.4
Rev: src/configure.in:1.149
Rev: src/cpp.c:1.3
Rev: src/docode.c:1.24
Rev: src/docode.h:1.4
Rev: src/gc.c:1.24
Rev: src/interpret.c:1.57
Rev: src/interpret.h:1.16
Rev: src/language.yacc:1.51
Rev: src/las.c:1.40
Rev: src/las.h:1.9
Rev: src/lex.c:1.37
Rev: src/lex.h:1.7
Rev: src/main.c:1.32
Rev: src/modules/Image/blit.c:1.26
Rev: src/modules/Image/colortable.c:1.33
Rev: src/modules/Image/dct.c:1.11
Rev: src/modules/Image/image.c:1.73
Rev: src/modules/Image/matrix.c:1.13
Rev: src/modules/Image/operator.c:1.11
Rev: src/modules/Image/pattern.c:1.11
Rev: src/modules/Image/pnm.c:1.9
Rev: src/modules/Image/polyfill.c:1.18
Rev: src/modules/Image/togif.c:1.29
Rev: src/modules/Image/x.c:1.17
Rev: src/modules/Pipe/pipe.c:1.15
Rev: src/modules/Regexp/glue.c:1.9
Rev: src/modules/_Crypto/cbc.c:1.10
Rev: src/modules/_Crypto/crypto.c:1.24
Rev: src/modules/_Crypto/des.c:1.11
Rev: src/modules/_Crypto/pipe.c:1.11
Rev: src/modules/_Crypto/sha.c:1.9
Rev: src/modules/files/socktest.pike:1.6
Rev: src/modules/system/system.c:1.37
Rev: src/object.c:1.31
Rev: src/object.h:1.13
Rev: src/opcodes.c:1.10
Rev: src/operators.c:1.22
Rev: src/peep.c:1.16
Rev: src/peep.in:1.9
Rev: src/pike_types.c:1.27
Rev: src/pike_types.h:1.6
Rev: src/program.c:1.48
Rev: src/program.h:1.24
Rev: src/program_areas.h:1.2
Rev: src/stralloc.c:1.21
Rev: src/stralloc.h:1.10
Rev: src/svalue.c:1.18
Rev: src/testsuite.in:1.64
Rev: src/threads.c:1.51
Rev: src/threads.h:1.26

4:   ||| See the files COPYING and DISCLAIMER for more information.   \*/   #include "global.h" - RCSID("$Id: interpret.c,v 1.56 1997/12/22 17:35:23 hubbe Exp $"); + RCSID("$Id: interpret.c,v 1.57 1998/01/13 22:56:43 hubbe Exp $");   #include "interpret.h"   #include "object.h"   #include "program.h"
180:   }       - static void eval_instruction(unsigned char *pc); + static int eval_instruction(unsigned char *pc);         /*
476:      static int o_catch(unsigned char *pc);    - static void eval_instruction(unsigned char *pc) + static int eval_instruction(unsigned char *pc)   { -  unsigned INT32 instr, prefix=0; +  unsigned INT32 accumulator=0,instr, prefix=0;    while(1)    {    fp->pc = pc;
562:    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;
616:    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());
1075:       CASE(F_CATCH);    if(o_catch(pc+sizeof(INT32))) -  return; /* There was a return inside the evaluated code */ +  return -1; /* There was a return inside the evaluated code */    else    pc+=EXTRACT_INT(pc);    break;
1122:    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); -  pop_n_elems(sp-fp->locals); +     push_int(1);    goto do_return;       CASE(F_RETURN_0); -  pop_n_elems(sp-fp->locals); +     push_int(0);    goto do_return;       CASE(F_RETURN); -  if(fp->locals != sp-1) -  { -  assign_svalue(fp->locals, sp-1); -  pop_n_elems(sp - fp->locals - 1); -  } -  +     do_return: - #ifdef DEBUG -  if(d_flag > 2) -  do_gc(); - #endif + #if defined(DEBUG) && defined(GC2) +  if(d_flag > 2) do_gc();    check_threads_etc(); -  + #endif       /* fall through */       CASE(F_DUMB_RETURN); -  return; +  return -1;       CASE(F_NEGATE);    if(sp[-1].type == T_INT)
1313:    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);    }    }   }    - /* Put catch outside of eval_instruction, so -  * the setjmp won't affect the optimization of -  * eval_instruction + 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    */ - static int o_catch(unsigned char *pc) +  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:    { -  JMP_BUF tmp; -  if(SETJMP(tmp)) +  struct svalue *s=(struct svalue *)arg1; +  switch(s->type)    { -  *sp=throw_value; -  throw_value.type=T_INT; -  sp++; -  UNSETJMP(tmp); -  return 0; -  }else{ -  eval_instruction(pc); -  UNSETJMP(tmp); -  return 1; +  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);    -  - int apply_low_safe_and_stupid(struct object *o, INT32 offset) +  case T_FUNCTION: +  if(s->subtype == FUNCTION_BUILTIN)    { -  JMP_BUF tmp; -  struct frame new_frame; -  int ret; +  (*(s->u.efun->function))(args); +  break; +  }else{ +  o=s->u.object; +  fun=s->subtype; +  goto apply_low; +  } +  break;    -  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; -  fp = & new_frame; +  case T_ARRAY: +  apply_array(s->u.array,args); +  break;    -  new_frame.current_object->refs++; -  new_frame.context.prog->refs++; +  case T_PROGRAM: +  push_object(clone_object(s->u.program,args)); +  break;    -  if(SETJMP(tmp)) -  { -  ret=1; -  }else{ -  eval_instruction(o->prog->program + offset); +  case T_OBJECT: +  o=s->u.object; +  fun=LFUN_CALL; +  goto call_lfun; +  } +  break; +  } +  +  call_lfun:   #ifdef DEBUG -  if(sp<evaluator_stack) -  fatal("Stack error (simple).\n"); +  if(fun < 0 || fun >= NUM_LFUNS) +  fatal("Apply lfun on illegal value!\n");   #endif -  ret=0; -  } -  UNSETJMP(tmp); +  if(!o->prog) +  error("Apply on destructed object.\n"); +  fun=FIND_LFUN(o->prog,fun); +  goto apply_low;    -  free_object(new_frame.current_object); -  free_program(new_frame.context.prog); +     -  fp = new_frame.parent_frame; -  return ret; - } +  case APPLY_LOW: +  o=(struct object *)arg1; +  fun=(long)arg2;    - void apply_low(struct object *o, int fun, int args) +  apply_low:   {    struct program *p;    struct reference *ref;
1396:    return;    }    -  o->refs++; -  -  fast_check_threads_etc(4); +  check_threads_etc();    check_stack(256);    check_mark_stack(256);   
1424:    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;
1432:    new_frame.current_storage = o->storage+new_frame.context.storage_offset;    new_frame.pc = 0;    - /* new_frame.current_object->refs++; Moved to beginning of function / Hubbe */ +  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;
1478:    if(nonblock)    set_nonblocking(2,1);    } + #endif       fp = &new_frame;    - #ifdef PROFILING -  function->num_calls++; - #endif /* PROFILING */ -  +     if(function->func.offset == -1)    error("Calling undefined function '%s'.\n",function->name->str);    -  if(function->identifier_flags & IDENTIFIER_C_FUNCTION) +  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); -  }else{ +  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;
1531:   #endif    new_frame.num_locals=num_locals;    new_frame.num_args=num_args; -  eval_instruction(pc); +  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);
1550:    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;
1581:    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;
1621:    }    }    UNSETJMP(recovery); -  +    }    -  +    void safe_apply(struct object *o, char *fun ,INT32 args)   {   #ifdef DEBUG
1641:    if(!o->prog)    error("Apply on destructed object.\n");    -  apply_low(o, o->prog->lfuns[fun], args); +  apply_low(o, (int)FIND_LFUN(o->prog,fun), args);   }      void apply_shared(struct object *o,
1656:    apply_low(o, find_identifier(fun, o->prog), args);   }    - void strict_apply_svalue(struct svalue *s, INT32 args) - { -  struct svalue *save_sp; -  save_sp=sp-args; -  if(t_flag>1) -  { -  char *file, *f; -  INT32 linep,e,nonblock; -  char *st; +     -  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(); -  describe_svalue(s,0,0); -  my_strcat("("); -  for(e=0;e<args;e++) -  { -  if(e) my_strcat(","); -  describe_svalue(sp-args+e,0,0); -  } -  my_strcat(")"); -  st=simple_free_buf(); -  if((long)strlen(st) > (long)TRACE_LEN) -  { -  st[TRACE_LEN]=0; -  st[TRACE_LEN-1]='.'; -  st[TRACE_LEN-2]='.'; -  st[TRACE_LEN-2]='.'; -  } -  fprintf(stderr,"- %s:%4ld: %s\n",file,(long)linep,st); -  free(st); -  -  if(nonblock) -  set_nonblocking(2,1); -  } -  -  switch(s->type) -  { -  case T_FUNCTION: -  if(s->subtype == FUNCTION_BUILTIN) -  { -  (*(s->u.efun->function))(args); -  }else{ -  apply_low(s->u.object, s->subtype, args); -  } -  break; -  -  case T_ARRAY: -  apply_array(s->u.array,args); -  break; -  -  case T_PROGRAM: -  { -  struct object *o=clone_object(s->u.program,args); -  push_object(o); -  } -  break; -  -  case T_OBJECT: -  if(!s->u.object->prog) -  error("Calling a destructed object.\n"); -  -  if(s->u.object->prog->lfuns[LFUN_CALL] == -1) -  error("Calling object without `() operator\n"); -  -  apply_lfun(s->u.object, LFUN_CALL, args); -  break; -  -  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"); -  case T_MULTISET: -  error("Attempt to call a multiset\n"); -  default: -  error("Call to non-function value type:%d.\n", s->type); -  } -  -  if(t_flag>1 && sp>save_sp) -  { -  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); -  } - } -  +    void apply_svalue(struct svalue *s, INT32 args)   {    if(s->type==T_INT)