pike.git / src / program.c

version» Context lines:

pike.git/src/program.c:36:   #include "module_support.h"   #include "bitvector.h"   #include "sprintf.h"      #include <errno.h>   #include <fcntl.h>      #define sp Pike_sp       - #ifdef PIKE_THREADS - static COND_T Pike_compiler_cond; - static THREAD_T Pike_compiler_thread; - static int lock_depth = 0; -  - PMOD_EXPORT void lock_pike_compiler(void) - { -  if (lock_depth && (Pike_compiler_thread != th_self())) { -  SWAP_OUT_CURRENT_THREAD(); -  while (lock_depth && (Pike_compiler_thread != th_self())) { -  co_wait_interpreter(&Pike_compiler_cond); -  } -  SWAP_IN_CURRENT_THREAD(); -  } -  lock_depth++; -  Pike_compiler_thread = th_self(); - } -  - PMOD_EXPORT void unlock_pike_compiler(void) - { - #ifdef PIKE_DEBUG -  if (lock_depth < 1) { -  Pike_fatal("Pike compiler running unlocked!\n"); -  } - #endif -  lock_depth--; -  co_broadcast(&Pike_compiler_cond); - } - #else - PMOD_EXPORT void lock_pike_compiler(void) - { - } - PMOD_EXPORT void unlock_pike_compiler(void) - { - } - #endif -  - static void low_enter_compiler(struct object *ce, int inherit); +    static void exit_program_struct(struct program *);   static size_t add_xstorage(size_t size,    size_t alignment,    ptrdiff_t modulo_orig);      /* mapping(int:string) */   static struct mapping *reverse_symbol_table = NULL;      static struct block_allocator program_allocator = BA_INIT_PAGES(sizeof(struct program), 4);   
pike.git/src/program.c:1521:    */      /*! @endclass    */      struct program *first_program = 0;   static int current_program_id = PROG_DYNAMIC_ID_START;      struct program *null_program=0;    - static struct program *reporter_program = NULL; - struct program *compilation_program = 0; - struct program *compilation_env_program = 0; - struct object *compilation_environment = NULL; -  +    struct program *gc_internal_program = 0;   static struct program *gc_mark_program_pos = 0;      #define CHECK_FILE_ENTRY(PROG, STRNO) \    do { \    if ((STRNO < 0) || (STRNO >= PROG->num_strings)) \    Pike_fatal ("Invalid file entry in linenumber info.\n"); \    } while (0)      INT_TYPE get_small_number(char **q);
pike.git/src/program.c:8525:    if (s) {    push_string(s);    yyreport(REPORT_ERROR, parser_system_string, 1, "%s");    }    }       pop_stack();    free_svalue(&thrown);   }    - extern int yyparse(void); -  - static void do_yyparse(void) - { -  struct svalue *save_sp = Pike_sp; -  yyparse(); /* Parse da program */ -  if (save_sp != Pike_sp) { - #ifdef PIKE_DEBUG -  if (!Pike_compiler->num_parse_error) { -  Pike_fatal("yyparse() left %"PRINTPTRDIFFT"d droppings on the stack!\n", -  Pike_sp - save_sp); -  } - #endif -  pop_n_elems(Pike_sp - save_sp); -  } - } -  - /* -  * Supporters. -  * -  * Supporters are used to register that a program being compiled depends on -  * another program that also is being compiled. -  * -  * Every program being compiled has a supporter (in the compilation -  * struct). -  */ -  - struct Supporter *current_supporter=0; -  -  - #ifdef PIKE_DEBUG -  - struct supporter_marker - { -  struct supporter_marker *next; -  void *data; -  int level, verified; - }; -  - #undef INIT_BLOCK - #define INIT_BLOCK(X) do { (X)->level = (X)->verified = 0; }while(0) - PTR_HASH_ALLOC(supporter_marker, 128); -  - static int supnum; -  - #define SNUM(X) (get_supporter_marker((X))->level) -  - static void mark_supporters(struct Supporter *s) - { -  struct supporter_marker *m; -  -  if(!s) return; -  debug_malloc_touch(s); -  m=get_supporter_marker(s); -  -  if(m->level) return; -  m->level = -1; -  -  if(s->magic != 0x500b0127) -  { - #ifdef DEBUG_MALLOC -  describe(s); - #endif -  Pike_fatal("This is not a supporter (addr=%p, magic=%x)!\n",s,s->magic); -  } -  -  mark_supporters(s->dependants); -  mark_supporters(s->next_dependant); -  -  m->level=supnum++; -  -  mark_supporters(s->previous); -  mark_supporters(s->depends_on); - } -  - static void low_verify_supporters(struct Supporter *s) - { -  struct Supporter *ss; -  struct supporter_marker *m; -  -  if(!s) return; -  debug_malloc_touch(s); -  m=get_supporter_marker(s); -  -  if(m->verified) return; -  m->verified = 1; -  -  low_verify_supporters(s->dependants); -  low_verify_supporters(s->next_dependant); -  - #if 0 -  fprintf(stderr, "low_verify_supporters %p%s, level %d: " -  "previous %p, depends_on %p, dependants %p, next_dependant %p\n", -  s, s == current_supporter ? " == current_supporter" : "", -  m->level, s->previous, s->depends_on, s->dependants, s->next_dependant); - #endif -  -  if(s->previous && SNUM(s->previous) <= m->level) -  Pike_fatal("Que, numbers out of whack1\n"); -  -  if(s->depends_on && SNUM(s->depends_on) <= m->level) -  Pike_fatal("Que, numbers out of whack2\n"); -  -  for(ss=s->dependants;ss;ss=ss->next_dependant) { -  if (ss->depends_on != s) -  Pike_fatal("Dependant hasn't got depends_on set properly.\n"); -  if(SNUM(ss) >= m->level) -  Pike_fatal("Que, numbers out of whack3\n"); -  } -  -  low_verify_supporters(s->previous); -  low_verify_supporters(s->depends_on); - } -  - void verify_supporters() - { -  if(d_flag) -  { -  supnum=1; -  init_supporter_marker_hash(); -  - #if 0 -  fprintf(stderr, "verify_supporters start\n"); - #endif -  -  mark_supporters(current_supporter); -  low_verify_supporters(current_supporter); - #ifdef DO_PIKE_CLEANUP -  { -  size_t e=0; -  for(e=0;e<supporter_marker_hash_table_size;e++) -  while(supporter_marker_hash_table[e]) -  remove_supporter_marker(supporter_marker_hash_table[e]->data); -  } - #endif -  exit_supporter_marker_hash(); -  - #if 0 -  fprintf(stderr, "verify_supporters end\n"); - #endif -  } - } - #else - #define verify_supporters(); - #endif -  - void init_supporter(struct Supporter *s, -  supporter_callback *fun, -  void *data) - { -  CDFPRINTF("th(%ld) init_supporter() supporter=%p data=%p.\n", -  (long) th_self(), s, data); -  verify_supporters(); - #ifdef PIKE_DEBUG -  s->magic = 0x500b0127; - #endif -  s->previous=current_supporter; -  current_supporter=s; -  -  s->depends_on=0; -  s->dependants=0; -  s->next_dependant=0; -  s->fun=fun; -  s->data=data; -  s->prog=0; -  verify_supporters(); - } -  - int unlink_current_supporter(struct Supporter *c) - { -  int ret=0; - #ifdef PIKE_DEBUG -  if(c != current_supporter) -  Pike_fatal("Previous unlink failed.\n"); - #endif -  debug_malloc_touch(c); -  verify_supporters(); -  if(c->depends_on) -  { - #ifdef PIKE_DEBUG -  struct Supporter *s; -  for (s = c->depends_on->dependants; s; s = s->next_dependant) -  if (s == c) Pike_fatal("Dependant already linked in.\n"); - #endif -  ret++; -  c->next_dependant = c->depends_on->dependants; -  c->depends_on->dependants=c; -  add_ref(c->self); -  CDFPRINTF("th(%ld) unlink_current_supporter() " -  "supporter=%p (prog %p) depends on %p (prog %p).\n", -  (long) th_self(), c, c->prog, -  c->depends_on, c->depends_on->prog); -  } -  current_supporter=c->previous; -  verify_supporters(); -  return ret; - } -  - void free_supporter(struct Supporter *c) - { -  verify_supporters(); -  if (c->depends_on) { -  struct Supporter **s; -  for (s = &c->depends_on->dependants; *s; s = &(*s)->next_dependant) -  if (*s == c) {*s = c->next_dependant; break;} -  c->depends_on = 0; -  } -  verify_supporters(); - } -  - int call_dependants(struct Supporter *s, int finish) - { -  int ok = 1; -  struct Supporter *tmp; -  CDFPRINTF("th(%ld) call_dependants() supporter=%p (prog %p) " -  "finish=%d.\n", (long) th_self(), s, s->prog, finish); -  verify_supporters(); -  while((tmp=s->dependants)) -  { -  CDFPRINTF("th(%ld) dependant: %p (prog %p) (data:%p).\n", -  (long) th_self(), tmp, tmp->prog, tmp->data); -  s->dependants=tmp->next_dependant; - #ifdef PIKE_DEBUG -  tmp->next_dependant=0; - #endif -  verify_supporters(); -  if (!tmp->fun(tmp->data, finish)) ok = 0; -  verify_supporters(); -  free_object(tmp->self); -  } -  return ok; - } -  - int report_compiler_dependency(struct program *p) - { -  int ret=0; -  struct Supporter *c,*cc; -  -  if (p == Pike_compiler->new_program) { -  /* Depends on self... */ -  return 0; -  } -  -  CDFPRINTF("th(%ld) compiler dependency on %p from %p\n", -  (long)th_self(), p, Pike_compiler->new_program); -  -  verify_supporters(); -  if (Pike_compiler->flags & COMPILATION_FORCE_RESOLVE) -  return 0; -  for(cc=current_supporter;cc;cc=cc->previous) -  { -  if(cc->prog && -  !(cc->prog->flags & PROGRAM_PASS_1_DONE)) -  { -  c=cc->depends_on; -  if(!c) c=cc->previous; -  for(;c;c=c->previous) -  { -  if(c->prog == p) -  { -  cc->depends_on=c; -  CDFPRINTF("th(%ld) supporter %p (prog %p) " -  "now depends on %p (prog %p)\n", -  (long) th_self(), cc, cc->prog, c, c->prog); -  verify_supporters(); -  ret++; /* dependency registred */ -  } -  } -  } -  } -  verify_supporters(); -  return ret; - } -  - /*! @class Reporter -  *! -  *! API for reporting parse errors and similar. -  */ -  - /*! @decl enum SeverityLevel -  *! Message severity level. -  *! { NOTICE, WARNING, ERROR, FATAL } -  *! -  *! @constant NOTICE -  *! @constant WARNING -  *! @constant ERROR -  *! @constant FATAL -  *! -  *! @seealso -  *! @[report()] -  */ -  - /*! @decl void report(SeverityLevel severity, @ -  *! string filename, int(1..) linenumber, @ -  *! string subsystem, @ -  *! string message, mixed ... extra_args) -  *! -  *! Report a diagnostic from the compiler. -  *! -  *! @param severity -  *! The severity of the diagnostic. -  *! -  *! @param filename -  *! @param linenumber -  *! Location which triggered the diagnostic. -  *! -  *! @param subsystem -  *! Compiler subsystem that generated the diagnostic. -  *! -  *! @param message -  *! @[sprintf()]-style formatting string with the diagnostic message. -  *! -  *! @param extra_args -  *! Extra arguments to @[sprintf()]. -  *! -  *! The default implementation does the following: -  *! -  *! @ul -  *! @item -  *! If there's a @[MasterObject()->report()], call it -  *! with the same arguments as ourselves. -  *! @item -  *! Otherwise depending on @[severity]: -  *! @int -  *! @value NOTICE -  *! Ignored. -  *! @value WARNING -  *! Calls @[MasterObject()->compile_warning()]. -  *! @value ERROR -  *! @value FATAL -  *! Calls @[MasterObject()->compile_error()]. -  *! @endint -  *! @endul -  *! -  *! If there's no master object yet, the diagnostic is output to -  *! @[Stdio.stderr]. -  *! -  *! @note -  *! In Pike 7.8 and earlier @[MasterObject()->report()] was not called. -  *! -  *! @seealso -  *! @[PikeCompiler()->report()] -  */ - /* NOTE: This function MUST NOT use any storage in the Reporter program! */ - static void f_reporter_report(INT32 args) - { -  int level; -  struct pike_string *filename; -  INT_TYPE linenumber; -  struct pike_string *subsystem; -  struct pike_string *message; -  struct object *master_ob; -  -  if ((master_ob = get_master()) && master_ob->prog) { -  int fun = find_identifier("report", master_ob->prog); -  if (fun >= 0) { -  apply_low(master_ob, fun, args); -  return; -  } -  } -  -  if (args > 5) { -  f_sprintf(args - 4); -  args = 5; -  } -  get_all_args("report", args, "%d%W%+%W%W", -  &level, &filename, &linenumber, &subsystem, &message); -  -  /* Ignore informational level messages */ -  if (level >= REPORT_WARNING) { -  if (master_ob && master_ob->prog) { -  ref_push_string(filename); -  push_int(linenumber); -  ref_push_string(message); -  if (level >= REPORT_ERROR) { -  APPLY_MASTER("compile_error", 3); -  args++; -  } else { -  APPLY_MASTER("compile_warning", 3); -  args++; -  } -  } else { -  /* We hope that errors from compiling the master -  * won't contain wide-strings... */ -  if (level >= REPORT_ERROR) { -  fprintf(stderr, "%s:%ld: %s\n", -  filename->str, (long)linenumber, message->str); -  } else { -  fprintf(stderr, "%s:%ld: Warning: %s\n", -  filename->str, (long)linenumber, message->str); -  } -  fflush(stderr); -  } -  } -  pop_n_elems(args); -  push_int(0); - } -  - /*! @endclass -  */ -  - /*! @module DefaultCompilerEnvironment -  *! -  *! The @[CompilerEnvironment] object that is used -  *! for loading C-modules and by @[predef::compile()]. -  *! -  *! @note -  *! @[predef::compile()] is essentially an alias for the -  *! @[CompilerEnvironment()->compile()] in this object. -  *! -  *! @seealso -  *! @[CompilerEnvironment], @[predef::compile()] -  */ -  - /*! @decl inherit CompilerEnvironment -  */ -  - /*! @endmodule -  */ -  - /*! @class CompilerEnvironment -  *! -  *! The compiler environment. -  *! -  *! By inheriting this class and overloading the functions, -  *! it is possible to make a custom Pike compiler. -  *! -  *! @note -  *! Prior to Pike 7.8 this sort of customization has to be done -  *! either via custom master objects, or via @[CompilationHandler]s. -  *! -  *! @seealso -  *! @[CompilationHandler], @[MasterObject], @[master()], @[replace_master()] -  */ -  - /*! @decl inherit Reporter -  *! -  *! Implements the @[Reporter] API. -  *! -  *! @seealso -  *! @[Reporter()->report()], @[Reporter()->SeverityLevel] -  */ -  - /*! @class lock -  *! -  *! This class acts as a lock against other threads accessing the compiler. -  *! -  *! The lock is released when the object is destructed. -  */ -  - static void compiler_environment_lock_event_handler(int e) - { -  switch(e) { -  case PROG_EVENT_INIT: -  lock_pike_compiler(); -  break; -  case PROG_EVENT_EXIT: -  unlock_pike_compiler(); -  break; -  } - } -  - /*! @endclass -  */ -  - /*! @decl program compile(string source, CompilationHandler|void handler, @ -  *! int|void major, int|void minor,@ -  *! program|void target, object|void placeholder) -  *! -  *! Compile a string to a program. -  *! -  *! This function takes a piece of Pike code as a string and -  *! compiles it into a clonable program. -  *! -  *! The optional argument @[handler] is used to specify an alternative -  *! error handler. If it is not specified the current master object will -  *! be used. -  *! -  *! The optional arguments @[major] and @[minor] are used to tell the -  *! compiler to attempt to be compatible with Pike @[major].@[minor]. -  *! -  *! @note -  *! This function essentially performs -  *! @code -  *! program compile(mixed ... args) -  *! { -  *! return PikeCompiler(@@args)->compile(); -  *! } -  *! @endcode -  *! -  *! @note -  *! Note that @[source] must contain the complete source for a program. -  *! It is not possible to compile a single expression or statement. -  *! -  *! Also note that @[compile()] does not preprocess the program. -  *! To preprocess the program you can use @[compile_string()] or -  *! call the preprocessor manually by calling @[cpp()]. -  *! -  *! @seealso -  *! @[compile_string()], @[compile_file()], @[cpp()], @[master()], -  *! @[CompilationHandler] -  */ - static void f_compilation_env_compile(INT32 args) - { -  apply_current(CE_PIKE_COMPILER_FUN_NUM, args); -  args = 1; -  if (TYPEOF(Pike_sp[-1]) != T_OBJECT) { -  Pike_error("Bad return value from PikeCompiler().\n"); -  } -  apply(Pike_sp[-1].u.object, "compile", 0); -  stack_pop_n_elems_keep_top(args); - } -  - /*! @decl mixed resolv(string identifier, string filename, @ -  *! object|void handler) -  *! -  *! Look up @[identifier] in the current context. -  *! -  *! The default implementation calls the corresponding -  *! function in the master object. -  */ - static void f_compilation_env_resolv(INT32 args) - { -  struct pike_string *ident; -  struct pike_string *filename; -  struct object *handler = NULL; -  -  get_all_args("resolv", args, "%W%W.%O", -  &ident, &filename, &handler); -  -  if(get_master()) -  { -  DECLARE_CYCLIC(); -  if(BEGIN_CYCLIC(ident, filename)) -  { -  my_yyerror("Recursive module dependency in %S.", ident); -  }else{ -  SET_CYCLIC_RET(1); -  -  APPLY_MASTER("resolv", args); -  } -  END_CYCLIC(); -  } else { -  pop_n_elems(args); -  push_undefined(); -  } - } -  - /*! @decl object get_compilation_handler(int major, int minor) -  *! -  *! Get compatibility handler for Pike @[major].@[minor]. -  *! -  *! The default implementation calls the corresponding -  *! function in the master object. -  *! -  *! @note -  *! This function is typically called by -  *! @[PikeCompiler()->get_compilation_handler()]. -  *! -  *! @seealso -  *! @[MasterObject()->get_compilation_handler()]. -  */ - static void f_compilation_env_get_compilation_handler(INT32 args) - { -  if(get_master()) -  { -  APPLY_MASTER("get_compilation_handler", args); -  } else { -  pop_n_elems(args); -  push_undefined(); -  } - } -  - /*! @decl mapping(string:mixed)|object get_default_module() -  *! -  *! Get the default module for the current compatibility level -  *! (ie typically the value returned by @[predef::all_constants()]). -  *! -  *! The default implementation calls the corresponding function -  *! in the master object. -  *! -  *! @returns -  *! @mixed -  *! @type mapping(string:mixed)|object -  *! Constant table to use. -  *! -  *! @type int(0..0) -  *! Use the builtin constant table. -  *! @endmixed -  *! -  *! @note -  *! This function is typically called by -  *! @[Pike_compiler()->get_default_module()]. -  *! -  *! @seealso -  *! @[MasterObject()->get_default_module()]. -  */ - static void f_compilation_env_get_default_module(INT32 args) - { -  if(get_master()) -  { -  APPLY_MASTER("get_default_module", args); -  } else { -  pop_n_elems(args); -  push_undefined(); -  } - } -  - /*! @decl program handle_inherit(string inh, string current_file, @ -  *! object|void handler) -  *! -  *! Look up an inherit @[inh]. -  *! -  *! The default implementation calls the corresponding function -  *! in the master object. -  *! -  *! @seealso -  *! @[MasterObject()->handle_inherit()]. -  */ - static void f_compilation_env_handle_inherit(INT32 args) - { -  if(get_master()) -  { -  APPLY_MASTER("handle_inherit", args); -  } else { -  pop_n_elems(args); -  push_undefined(); -  } - } -  - #if 0 - /* @decl int filter_exception(SeverityLevel level, mixed err) -  * -  * The default implementation calls -  * @[MasterObject()->compile_exception()] for @[level] @[ERROR] -  * and @[FATAL]. -  * -  * @note -  * This function is not implemented in Pike 7.8. -  * -  * @seealso -  * @[MasterObject()->compile_exception()]. -  */ - static void f_compilation_env_filter_exception(INT32 args) - { -  int level; -  struct svalue *err; -  -  get_all_args("filter_exception", args, "%d%*", &level, &err); -  if (args > 2) { -  pop_n_elems(args-2); -  args = 2; -  } -  - #if 0 -  if (level >= REPORT_WARNING) { -  if (level >= REPORT_ERROR) { -  APPLY_MASTER("compile_exception", 1); -  /* FIXME! */ -  } else { -  push_int(level); -  push_string(format_exception_for_error_msg(err)); -  /* FIXME! */ -  } -  } - #endif -  -  pop_n_elems(args); -  push_undefined(); -  return; - } - #endif -  - /*! @class PikeCompiler -  *! -  *! The Pike compiler. -  *! -  *! An object of this class compiles a single string -  *! of Pike code. -  */ -  - static void free_compilation(struct compilation *c) - { -  debug_malloc_touch(c); -  if (c->prog) { -  free_string(c->prog); -  c->prog = NULL; -  } -  if(c->handler) { -  free_object(c->handler); -  c->handler = NULL; -  } -  if(c->compat_handler) { -  free_object(c->compat_handler); -  c->compat_handler = NULL; -  } -  if(c->target) { -  free_program(c->target); -  c->target = NULL; -  } -  if(c->p) { -  free_program(c->p); -  c->p = NULL; -  } -  if(c->placeholder) { -  free_object(c->placeholder); -  c->placeholder = NULL; -  } -  if(c->lex.current_file) { -  free_string(c->lex.current_file); -  c->lex.current_file = NULL; -  } -  if(c->lex.attributes) { -  free_node(c->lex.attributes); -  c->lex.attributes = NULL; -  } -  if (c->resolve_cache) { -  free_mapping(c->resolve_cache); -  c->resolve_cache = NULL; -  } -  free_svalue(& c->default_module); -  SET_SVAL(c->default_module, T_INT, NUMBER_NUMBER, integer, 0); -  free_supporter(&c->supporter); -  verify_supporters(); - } -  - static void run_init(struct compilation *c) - { -  debug_malloc_touch(c); -  -  if (c->compat_handler) free_object(c->compat_handler); -  c->compat_handler=0; -  -  if (c->resolve_cache) { -  free_mapping(c->resolve_cache); -  c->resolve_cache = 0; -  } -  -  c->lex.current_line=1; -  free_string(c->lex.current_file); -  c->lex.current_file=make_shared_string("-"); -  -  c->lex.attributes = NULL; -  -  if (runtime_options & RUNTIME_STRICT_TYPES) -  { -  c->lex.pragmas = ID_STRICT_TYPES; -  } else { -  c->lex.pragmas = 0; -  } -  -  c->lex.end = c->prog->str + (c->prog->len << c->prog->size_shift); -  -  switch(c->prog->size_shift) -  { -  case 0: c->lex.current_lexer = yylex0; break; -  case 1: c->lex.current_lexer = yylex1; break; -  case 2: c->lex.current_lexer = yylex2; break; -  } -  -  c->lex.pos=c->prog->str; - } -  - static void run_init2(struct compilation *c) - { - #if 0 -  int i; -  struct program *p; -  struct reference *refs; - #endif /* 0 */ -  debug_malloc_touch(c); -  Pike_compiler->compiler = c; -  -  /* Get the proper default module. */ -  safe_apply_current2(PC_GET_DEFAULT_MODULE_FUN_NUM, 0, NULL); -  if(TYPEOF(Pike_sp[-1]) == T_INT) -  { -  pop_stack(); -  ref_push_mapping(get_builtin_constants()); -  } -  assign_svalue(&c->default_module, Pike_sp-1); -  pop_stack(); -  -  use_module(& c->default_module); -  -  Pike_compiler->compat_major=PIKE_MAJOR_VERSION; -  Pike_compiler->compat_minor=PIKE_MINOR_VERSION; -  -  if(c->major>=0) -  change_compiler_compatibility(c->major, c->minor); -  - #if 0 -  /* Make all inherited private symbols that weren't overloaded -  * in the first pass local. -  */ -  p = c->new_program; -  i = p->num_identifier_references; -  refs = p->identifier_references; -  while (i--) { -  if (refs[i].id_flags & ID_PRIVATE) refs[i].id_flags |= ID_INLINE; -  } - #endif /* 0 */ - } -  - static void run_exit(struct compilation *c) - { -  debug_malloc_touch(c); -  - #ifdef PIKE_DEBUG -  if(c->num_used_modules) -  Pike_fatal("Failed to pop modules properly.\n"); - #endif -  - #ifdef PIKE_DEBUG -  if (c->compilation_depth != -1) { -  fprintf(stderr, "compile(): compilation_depth is %d\n", -  c->compilation_depth); -  } - #endif /* PIKE_DEBUG */ -  -  if (c->resolve_cache) { -  free_mapping(c->resolve_cache); -  c->resolve_cache = NULL; -  } -  -  verify_supporters(); - } -  - static void zap_placeholder(struct compilation *c) - { -  /* fprintf(stderr, "Destructing placeholder.\n"); */ -  if (c->placeholder->storage) { -  yyerror("Placeholder already has storage!"); - #if 0 -  fprintf(stderr, "Placeholder already has storage!\n" -  "placeholder: %p, storage: %p, prog: %p\n", -  c->placeholder, c->placeholder->storage, c->placeholder->prog); - #endif -  debug_malloc_touch(c->placeholder); -  destruct(c->placeholder); -  } else { -  /* FIXME: Is this correct? */ -  /* It would probably be nicer if it was possible to just call -  * destruct on the object, but this works too. -Hubbe -  */ -  free_program(c->placeholder->prog); -  c->placeholder->prog = NULL; -  debug_malloc_touch(c->placeholder); -  } -  free_object(c->placeholder); -  c->placeholder=0; -  verify_supporters(); - } -  - /* NOTE: Must not throw errors! */ - static int run_pass1(struct compilation *c) - { -  int ret=0; -  -  debug_malloc_touch(c); -  run_init(c); -  - #if 0 -  CDFPRINTF("th(%ld) compile() starting compilation_depth=%d\n", -  (long)th_self(), c->compilation_depth); - #endif -  -  if(c->placeholder && c->placeholder->prog != null_program) { -  yyerror("Placeholder object is not a null_program clone!"); -  return 0; -  } -  debug_malloc_touch(c->placeholder); -  -  if(c->target && !(c->target->flags & PROGRAM_VIRGIN)) { -  yyerror("Placeholder program is not virgin!"); -  return 0; -  } -  -  low_start_new_program(c->target,1,0,0,0); -  c->supporter.prog = Pike_compiler->new_program; -  -  CDFPRINTF("th(%ld) %p run_pass1() start: " -  "lock_depth:%d, compilation_depth:%d\n", -  (long)th_self(), Pike_compiler->new_program, -  lock_depth, c->compilation_depth); -  -  run_init2(c); -  -  if(c->placeholder) -  { -  if(c->placeholder->prog != null_program) -  { -  yyerror("Placeholder argument is not a null_program clone!"); -  c->placeholder=0; -  debug_malloc_touch(c->placeholder); -  }else{ -  free_program(c->placeholder->prog); -  add_ref(c->placeholder->prog=Pike_compiler->new_program); -  debug_malloc_touch(c->placeholder); -  } -  } -  - #if 0 -  CDFPRINTF("th(%ld) %p compile(): First pass\n", -  (long)th_self(), Pike_compiler->new_program); - #endif -  -  do_yyparse(); /* Parse da program */ -  -  if (!Pike_compiler->new_program->num_linenumbers) { -  /* The lexer didn't write an initial entry. */ -  store_linenumber(0, c->lex.current_file); - #ifdef DEBUG_MALLOC -  if(strcmp(c->lex.current_file->str,"-")) -  debug_malloc_name(Pike_compiler->new_program, c->lex.current_file->str, 0); - #endif -  } -  -  CDFPRINTF("th(%ld) %p run_pass1() done for %s\n", -  (long)th_self(), Pike_compiler->new_program, -  c->lex.current_file->str); -  -  ret=unlink_current_supporter(& c->supporter); -  -  c->p=debug_malloc_pass(end_first_pass(0)); -  -  run_exit(c); -  -  if(c->placeholder) -  { -  if(!c->p || (c->placeholder->storage)) -  { -  debug_malloc_touch(c->placeholder); -  zap_placeholder(c); -  } else { - #ifdef PIKE_DEBUG -  if (c->placeholder->prog != c->p) -  Pike_fatal("Placeholder object got wrong program after first pass.\n"); - #endif -  debug_malloc_touch(c->placeholder); -  c->placeholder->storage=c->p->storage_needed ? -  (char *)xcalloc(c->p->storage_needed, 1) : -  (char *)NULL; -  call_c_initializers(c->placeholder); -  } -  } -  -  verify_supporters(); -  return ret; - } -  - void run_pass2(struct compilation *c) - { -  debug_malloc_touch(c); -  debug_malloc_touch(c->placeholder); -  -  if (!c->p) { -  c->flags &= ~(COMPILER_BUSY); -  c->flags |= COMPILER_DONE; -  return; -  } -  -  run_init(c); -  low_start_new_program(c->p,2,0,0,0); -  free_program(c->p); -  c->p=0; -  -  run_init2(c); -  -  CDFPRINTF("th(%ld) %p run_pass2() start: " -  "lock_depth:%d, compilation_depth:%d\n", -  (long)th_self(), Pike_compiler->new_program, -  lock_depth, c->compilation_depth); -  -  verify_supporters(); -  -  do_yyparse(); /* Parse da program */ -  -  CDFPRINTF("th(%ld) %p run_pass2() done for %s\n", -  (long)th_self(), Pike_compiler->new_program, -  c->lex.current_file->str); -  -  verify_supporters(); -  -  c->p=debug_malloc_pass(end_program()); -  -  run_exit(c); - } -  - static void run_cleanup(struct compilation *c, int delayed) - { -  debug_malloc_touch(c); -  debug_malloc_touch(c->placeholder); - #if 0 /* FIXME */ - #ifdef PIKE_THREADS -  if (lock_depth != c->saved_lock_depth) { -  Pike_fatal("compile(): lock_depth:%d saved_lock_depth:%d\n", -  lock_depth, c->saved_lock_depth); -  } - #endif - #endif /* PIKE_DEBUG */ -  -  unlock_pike_compiler(); -  -  CDFPRINTF("th(%ld) %p run_cleanup(): " -  "lock_depth:%d, compilation_depth:%d\n", -  (long)th_self(), c->target, -  lock_depth, c->compilation_depth); -  if (!c->p) -  { -  /* fprintf(stderr, "Destructing placeholder.\n"); */ -  if(c->placeholder) { -  debug_malloc_touch(c->placeholder); -  zap_placeholder(c); -  } -  -  if(delayed && c->target) -  { -  struct program *p = c->target; -  -  /* Free the constants in the failed program, to untangle the -  * cyclic references we might have to this program, typically -  * in parent pointers in nested classes. */ -  if (p->constants) { -  int i; -  for (i = 0; i < p->num_constants; i++) { -  free_svalue(&p->constants[i].sval); -  SET_SVAL(p->constants[i].sval, T_INT, NUMBER_NUMBER, -  integer, 0); -  } -  } -  -  /* We have to notify the master object that -  * a previous compile() actually failed, even -  * if we did not know it at the time -  */ -  CDFPRINTF("th(%ld) %p unregistering failed delayed compile.\n", -  (long) th_self(), p); -  ref_push_program(p); -  /* FIXME: Shouldn't the compilation handler be used here? */ -  SAFE_APPLY_MASTER("unregister",1); -  pop_stack(); -  -  { - #ifdef PIKE_DEBUG -  int refs = p->refs; - #endif -  -  /* Free the target here to avoid false alarms in the debug -  * check below. */ -  free_program (c->target); -  c->target = NULL; -  - #ifdef PIKE_DEBUG -  if (refs > 1) { -  /* Other programs can have indexed out constants from p, which -  * might be broken themselves and/or keep references to p -  * through the parent pointer. We should find all those other -  * programs and invalidate them too, but how can that be done? -  * The whole delayed compilation thingie is icky icky icky... :P -  * /mast */ -  fprintf(stderr, "Warning: Program %p still got %d " -  "external refs after unregister:\n", p, p->refs); -  locate_references(p); -  fprintf (stderr, "Describing program:\n"); -  describe_something (p, T_PROGRAM, 0, 0, 0, NULL); -  } - #endif -  } -  } -  } -  else -  { -  if (c->placeholder) -  { -  if (c->target->flags & PROGRAM_FINISHED) { -  JMP_BUF rec; -  /* Initialize the placeholder. */ - #ifdef PIKE_DEBUG -  if (c->placeholder->prog != c->p) -  Pike_fatal("Placeholder object got wrong program after second pass.\n"); - #endif -  if(SETJMP(rec)) -  { -  handle_compile_exception (NULL); -  debug_malloc_touch(c->placeholder); -  zap_placeholder(c); -  }else{ -  debug_malloc_touch(c->placeholder); -  call_pike_initializers(c->placeholder,0); -  } -  UNSETJMP(rec); -  } -  else { -  debug_malloc_touch(c->placeholder); -  zap_placeholder(c); -  } -  } -  } -  verify_supporters(); -  c->flags &= ~(COMPILER_BUSY); -  c->flags |= COMPILER_DONE; - } -  - static int call_delayed_pass2(struct compilation *cc, int finish) - { -  int ok = 0; -  debug_malloc_touch(cc); -  -  debug_malloc_touch(cc->p); -  -  CDFPRINTF("th(%ld) %p %s delayed compile.\n", -  (long) th_self(), cc->p, finish ? "continuing" : "cleaning up"); -  -  /* Reenter the delayed compilation. */ -  add_ref(cc->supporter.self); -  low_enter_compiler(cc->supporter.self, cc->compilation_inherit); -  -  if(finish && cc->p) run_pass2(cc); -  run_cleanup(cc,1); -  -  exit_compiler(); -  -  debug_malloc_touch(cc); -  - #ifdef PIKE_DEBUG -  if(cc->supporter.dependants) -  Pike_fatal("Que???\n"); - #endif -  if(cc->p) { -  ok = finish; -  free_program(cc->p); /* later */ -  cc->p = NULL; -  } -  -  CDFPRINTF("th(%ld) %p delayed compile %s.\n", -  (long) th_self(), cc->target, ok ? "done" : "failed"); -  -  verify_supporters(); -  -  return ok; - } -  - static void compilation_event_handler(int e) - { -  struct compilation *c = THIS_COMPILATION; -  -  switch (e) { -  case PROG_EVENT_INIT: -  CDFPRINTF("th(%ld) compilation: INIT(%p).\n", (long) th_self(), c); -  memset(c, 0, sizeof(*c)); -  c->supporter.self = Pike_fp->current_object; /* NOTE: Not ref-counted! */ -  c->compilation_inherit = -  Pike_fp->context - Pike_fp->current_object->prog->inherits; -  buffer_init(&c->used_modules); -  SET_SVAL(c->default_module, T_MAPPING, 0, mapping, get_builtin_constants()); -  add_ref(c->default_module.u.mapping); -  c->major = -1; -  c->minor = -1; -  c->lex.current_line = 1; -  c->lex.current_file = make_shared_string("-"); -  c->compilation_depth = -1; -  break; -  case PROG_EVENT_EXIT: -  CDFPRINTF("th(%ld) compilation: EXIT(%p).\n", (long) th_self(), c); -  buffer_free(&c->used_modules); -  free_compilation(c); -  break; -  } - } -  - /*! @decl void report(SeverityLevel severity, @ -  *! string filename, int linenumber, @ -  *! string subsystem, @ -  *! string message, mixed ... extra_args) -  *! -  *! Report a diagnostic from the compiler. -  *! -  *! The default implementation attempts to call the first -  *! corresponding function in the active handlers in priority order: -  *! -  *! @ol -  *! @item -  *! Call handler->report(). -  *! @item -  *! Call handler->compile_warning() or handler->compile_error() -  *! depending on @[severity]. -  *! @item -  *! Call compat->report(). -  *! @item -  *! Call compat->compile_warning() or compat->compile_error() -  *! depending on @[severity]. -  *! @item -  *! Fallback: Call @[CompilerEnvironment()->report()] -  *! in the parent object. -  *! @endol -  *! -  *! The arguments will be as follows: -  *! @dl -  *! @item report() -  *! The report() function will be called with the same arguments -  *! as this function. -  *! @item compile_warning()/compile_error() -  *! Depending on the @[severity] either compile_warning() -  *! or compile_error() will be called. -  *! -  *! They will be called with the @[filename], @[linenumber] -  *! and formatted @[message] as arguments. -  *! -  *! Note that these will not be called for the @[NOTICE] severity, -  *! and that compile_error() will be used for both @[ERROR] and -  *! @[FATAL]. -  *! @enddl -  *! -  *! @note -  *! In Pike 7.8 and earlier the report() function was not called -  *! in the handlers. -  *! -  *! @seealso -  *! @[CompilerEnvironment()->report()] -  */ - static void f_compilation_report(INT32 args) - { -  struct compilation *c = THIS_COMPILATION; -  int level; -  struct pike_string *filename; -  INT_TYPE linenumber; -  struct pike_string *subsystem; -  struct pike_string *message; -  struct object *handler = NULL; -  int fun = -1; -  -  /* FIXME: get_all_args() ought to have a marker -  * indicating that we accept more arguments... -  */ -  get_all_args("report", args, "%d", &level); -  -  if ((c->handler || c->compat_handler)) { -  const char *fun_name = "compile_warning"; -  -  if (level >= REPORT_ERROR) fun_name = "compile_error"; -  -  if((handler = c->handler) && handler->prog) { -  if ((fun = find_identifier("report", handler->prog)) != -1) { -  apply_low(handler, fun, args); -  return; -  } -  if ((fun = find_identifier(fun_name, handler->prog)) != -1) { -  goto apply_handler; -  } -  } -  if ((handler = c->compat_handler) && handler->prog) { -  if ((fun = find_identifier("report", handler->prog)) != -1) { -  apply_low(handler, fun, args); -  return; -  } -  if ((fun = find_identifier(fun_name, handler->prog)) != -1) { -  goto apply_handler; -  } -  } -  } -  /* Nothing apropriate in any handlers. -  * Call the report() in our parent. -  */ -  apply_external(1, CE_REPORT_FUN_NUM, args); -  return; -  -  apply_handler: -  /* Ignore informational level messages */ -  if (level < REPORT_WARNING) return; -  if (args > 5) { -  f_sprintf(args - 4); -  args = 5; -  } -  get_all_args("report", args, "%d%W%+%W%W", -  &level, &filename, &linenumber, -  &subsystem, &message); -  -  ref_push_string(filename); -  push_int(linenumber); -  ref_push_string(message); -  apply_low(handler, fun, 3); -  stack_pop_n_elems_keep_top(args); - } -  - /*! @decl void create(string|void source, @ -  *! CompilationHandler|void handler, @ -  *! int|void major, int|void minor,@ -  *! program|void target, object|void placeholder) -  *! -  *! Create a PikeCompiler object for a source string. -  *! -  *! This function takes a piece of Pike code as a string and -  *! initializes a compiler object accordingly. -  *! -  *! @param source -  *! Source code to compile. -  *! -  *! @param handler -  *! The optional argument @[handler] is used to specify an alternative -  *! error handler. If it is not specified the current master object -  *! at compile time will be used. -  *! -  *! @param major -  *! @param minor -  *! The optional arguments @[major] and @[minor] are used to tell the -  *! compiler to attempt to be compatible with Pike @[major].@[minor]. -  *! -  *! @param target -  *! @[__empty_program()] program to fill in. The virgin program -  *! returned by @[__empty_program()] will be modified and returned -  *! by @[compile()] on success. -  *! -  *! @param placeholder -  *! @[__null_program()] placeholder object to fill in. The object -  *! will be modified into an instance of the resulting program -  *! on successfull compile. Note that @[lfun::create()] in the -  *! program will be called without any arguments. -  *! -  *! @note -  *! Note that @[source] must contain the complete source for a program. -  *! It is not possible to compile a single expression or statement. -  *! -  *! Also note that no preprocessing is performed. -  *! To preprocess the program you can use @[compile_string()] or -  *! call the preprocessor manually by calling @[cpp()]. -  *! -  *! @note -  *! Note that all references to @[target] and @[placeholder] should -  *! removed if @[compile()] failes. On failure the @[placeholder] -  *! object will be destructed. -  *! -  *! @seealso -  *! @[compile_string()], @[compile_file()], @[cpp()], @[master()], -  *! @[CompilationHandler] -  */ - static void f_compilation_create(INT32 args) - { -  struct pike_string *aprog = NULL; -  struct object *ahandler = NULL;/* error handler */ -  int amajor = -1; -  int aminor = -1; -  struct program *atarget = NULL; -  struct object *aplaceholder = NULL; -  int dependants_ok = 1; -  struct compilation *c = THIS_COMPILATION; -  -  if (c->flags & COMPILER_BUSY) { -  Pike_error("PikeCompiler object is in use.\n"); -  } -  -  STACK_LEVEL_START(args); -  -  get_all_args("create", args, ".%W%O%d%d%P%O", -  &aprog, &ahandler, -  &amajor, &aminor, -  &atarget, &aplaceholder); -  -  if (args == 3) { -  SIMPLE_ARG_TYPE_ERROR("create", 4, "int"); -  } -  -  check_c_stack(65536); -  -  CDFPRINTF("th(%ld) %p compilation create() enter, placeholder=%p\n", -  (long) th_self(), atarget, aplaceholder); -  -  debug_malloc_touch(c); -  -  verify_supporters(); -  -  c->flags &= ~COMPILER_DONE; -  -  if (c->p) free_program(c->p); -  c->p = NULL; -  -  if (c->prog) free_string(c->prog); -  if ((c->prog=aprog)) add_ref(aprog); -  -  if (c->handler) free_object(c->handler); -  if ((c->handler=ahandler)) add_ref(ahandler); -  -  if (c->target) free_program(c->target); -  if ((c->target=atarget)) add_ref(atarget); -  -  if (c->placeholder) free_object(c->placeholder); -  if ((c->placeholder=aplaceholder)) add_ref(aplaceholder); -  -  c->major = amajor?amajor:-1; -  c->minor = aminor?aminor:-1; -  -  STACK_LEVEL_DONE(args); -  pop_n_elems(args); -  -  push_int(0); - } -  - /*! @decl program compile() -  *! -  *! Compile the current source into a program. -  *! -  *! This function compiles the current Pike source code -  *! into a clonable program. -  *! -  *! @seealso -  *! @[compile_string()], @[compile_file()], @[cpp()], @[master()], -  *! @[CompilationHandler], @[create()] -  */ - static void f_compilation_compile(INT32 args) - { -  int delay, dependants_ok = 1; -  struct program *ret; - #ifdef PIKE_DEBUG -  ONERROR tmp; - #endif -  struct compilation *c = THIS_COMPILATION; -  -  if (c->flags & COMPILER_BUSY) { -  Pike_error("PikeCompiler in use.\n"); -  } -  -  get_all_args("compile", args, ""); -  -  check_c_stack(65536); -  -  CDFPRINTF("th(%ld) %p f_compilation_compile() enter, " -  "placeholder=%p\n", (long) th_self(), c->target, c->placeholder); -  -  debug_malloc_touch(c); -  -  verify_supporters(); -  -  if (c->flags & COMPILER_DONE) { -  /* Already compiled. */ -  pop_n_elems(args); -  if (c->p) ref_push_program(c->p); -  else push_int(0); -  return; -  } -  -  if (!c->prog) { -  /* No program text. */ -  low_start_new_program(c->target, 1, NULL, 0, NULL); -  c->p = end_program(); -  c->flags |= COMPILER_DONE; -  pop_n_elems(args); -  ref_push_program(c->p); -  return; -  } -  - #ifdef PIKE_DEBUG -  SET_ONERROR(tmp, fatal_on_error,"Compiler exited with longjump!\n"); - #endif -  -  c->flags |= COMPILER_BUSY; -  -  lock_pike_compiler(); - #ifdef PIKE_THREADS -  c->saved_lock_depth = lock_depth; - #endif -  -  init_supporter(& c->supporter, -  (supporter_callback *) call_delayed_pass2, -  (void *)c); -  -  delay=run_pass1(c); -  dependants_ok = call_dependants(& c->supporter, !!c->p ); - #ifdef PIKE_DEBUG -  /* FIXME */ -  UNSET_ONERROR(tmp); - #endif -  -  if(delay) -  { -  CDFPRINTF("th(%ld) %p f_compilation_compile() finish later, " -  "placeholder=%p.\n", -  (long) th_self(), c->target, c->placeholder); -  /* finish later */ -  verify_supporters(); -  /* We're hanging in the supporter. */ -  ret = debug_malloc_pass(c->p); -  }else{ -  CDFPRINTF("th(%ld) %p f_compilation_compile() finish now.\n", -  (long) th_self(), c->target); -  /* finish now */ -  run_pass2(c); -  debug_malloc_touch(c); -  run_cleanup(c,0); -  -  ret = debug_malloc_pass(c->p); -  -  debug_malloc_touch(c); -  -  if (!dependants_ok) { -  CDFPRINTF("th(%ld) %p f_compilation_compile() reporting failure " -  "since a dependant failed.\n", -  (long) th_self(), c->target); -  throw_error_object(fast_clone_object(compilation_error_program), 0, 0, 0, -  "Compilation failed.\n"); -  } -  if(!ret) { -  CDFPRINTF("th(%ld) %p f_compilation_compile() failed.\n", -  (long) th_self(), c->target); -  throw_error_object(fast_clone_object(compilation_error_program), 0, 0, 0, -  "Compilation failed.\n"); -  } -  debug_malloc_touch(ret); - #ifdef PIKE_DEBUG -  if (a_flag > 2) { -  dump_program_tables(ret, 0); -  } - #endif /* PIKE_DEBUG */ -  verify_supporters(); -  } -  pop_n_elems(args); -  if (ret) -  ref_push_program(ret); -  else -  push_int(0); - } -  - /*! @decl mixed resolv(string identifier, string filename, @ -  *! object handler) -  *! -  *! Resolve the symbol @[identifier]. -  *! -  *! The default implementation calls the corresponding function -  *! in any active handler, and otherwise falls back to -  *! @[CompilerEnvironment()->resolv()] in the parent object. -  */ - static void f_compilation_resolv(INT32 args) - { -  struct compilation *c = THIS_COMPILATION; -  struct object *handler; -  int fun = -1; -  -  if (((handler = c->handler) && handler->prog && -  ((fun = find_identifier("resolv", handler->prog)) != -1)) || -  ((handler = c->compat_handler) && handler->prog && -  ((fun = find_identifier("resolv", handler->prog)) != -1))) { -  apply_low(handler, fun, args); -  } else { -  apply_external(1, CE_RESOLV_FUN_NUM, args); -  } - } -  - /*! @decl object get_compilation_handler(int major, int minor) -  *! -  *! Get compatibility handler for Pike @[major].@[minor]. -  *! -  *! @note -  *! This function is called by @[change_compiler_compatibility()]. -  */ - static void f_compilation_get_compilation_handler(INT32 args) - { -  struct compilation *c = THIS_COMPILATION; -  struct object *handler; -  int fun = -1; -  -  if (((handler = c->handler) && handler->prog && -  ((fun = find_identifier("get_compilation_handler", handler->prog)) != -1)) || -  ((handler = c->compat_handler) && handler->prog && -  ((fun = find_identifier("get_compilation_handler", handler->prog)) != -1))) { -  apply_low(handler, fun, args); -  } else { -  apply_external(1, CE_GET_COMPILATION_HANDLER_FUN_NUM, args); -  } - } -  - /*! @decl mapping(string:mixed)|object get_default_module() -  *! -  *! Get the default module for the current compatibility level -  *! (ie typically the value returned by @[predef::all_constants()]). -  *! -  *! The default implementation calls the corresponding function -  *! in the current handler, the current compatibility handler -  *! or in the parent @[CompilerEnvironment] in that order. -  *! -  *! @returns -  *! @mixed -  *! @type mapping(string:mixed)|object -  *! Constant table to use. -  *! -  *! @type int(0..0) -  *! Use the builtin constant table. -  *! @endmixed -  *! -  *! @note -  *! This function is called by @[change_compiler_compatibility()]. -  */ - static void f_compilation_get_default_module(INT32 args) - { -  struct compilation *c = THIS_COMPILATION; -  struct object *handler; -  int fun = -1; -  -  if (((handler = c->handler) && handler->prog && -  ((fun = find_identifier("get_default_module", handler->prog)) != -1)) || -  ((handler = c->compat_handler) && handler->prog && -  ((fun = find_identifier("get_default_module", handler->prog)) != -1))) { -  apply_low(handler, fun, args); -  } else { -  apply_external(1, CE_GET_DEFAULT_MODULE_FUN_NUM, args); -  } - } -  - /*! @decl void change_compiler_compatibility(int major, int minor) -  *! -  *! Change compiler to attempt to be compatible with Pike @[major].@[minor]. -  */ - static void f_compilation_change_compiler_compatibility(INT32 args) - { -  struct compilation *c = THIS_COMPILATION; -  int major = -1; -  int minor = -1; -  -  STACK_LEVEL_START(args); -  -  get_all_args("change_compiler_compatibility", args, "%d%d", -  &major, &minor); -  -  if ((major == -1) && (minor == -1)) { -  major = PIKE_MAJOR_VERSION; -  minor = PIKE_MINOR_VERSION; -  } -  -  if ((major == Pike_compiler->compat_major) && -  (minor == Pike_compiler->compat_minor)) { -  /* Optimization: Already at this compat level. */ -  pop_n_elems(args); -  push_int(0); -  return; -  } -  -  Pike_compiler->compat_major=major; -  Pike_compiler->compat_minor=minor; -  -  /* Optimization: The up to date compiler shouldn't need a compat handler. */ -  if((major != PIKE_MAJOR_VERSION) || (minor != PIKE_MINOR_VERSION)) -  { -  apply_current(PC_GET_COMPILATION_HANDLER_FUN_NUM, args); -  -  if((TYPEOF(Pike_sp[-1]) == T_OBJECT) && (Pike_sp[-1].u.object->prog)) -  { -  if (SUBTYPEOF(Pike_sp[-1])) { -  /* FIXME: */ -  Pike_error("Subtyped compat handlers are not supported yet.\n"); -  } -  if (c->compat_handler == Pike_sp[-1].u.object) { -  /* Still at the same compat level. */ -  pop_stack(); -  push_int(0); -  return; -  } else { -  if(c->compat_handler) free_object(c->compat_handler); -  c->compat_handler = Pike_sp[-1].u.object; -  dmalloc_touch_svalue(Pike_sp-1); -  Pike_sp--; -  } -  } else { -  pop_stack(); -  if(c->compat_handler) { -  free_object(c->compat_handler); -  c->compat_handler = NULL; -  } else { -  /* No change in compat handler. */ -  push_int(0); -  return; -  } -  } -  } else { -  pop_n_elems(args); -  if (c->compat_handler) { -  free_object(c->compat_handler); -  c->compat_handler = NULL; -  } else { -  /* No change in compat handler. */ -  push_int(0); -  return; -  } -  } -  -  STACK_LEVEL_CHECK(0); -  -  Pike_fp->args = 0; /* Clean up the stack frame. */ -  -  apply_current(PC_GET_DEFAULT_MODULE_FUN_NUM, 0); -  -  if(TYPEOF(Pike_sp[-1]) == T_INT) -  { -  pop_stack(); -  ref_push_mapping(get_builtin_constants()); -  } -  -  STACK_LEVEL_CHECK(1); -  -  assign_svalue(&c->default_module, Pike_sp-1); -  -  /* Replace the implicit import of all_constants() with -  * the new value. -  */ -  if(c->num_used_modules) -  { -  struct svalue *dst = buffer_ptr(&c->used_modules); -  free_svalue( dst ); -  dst[0]=sp[-1]; -  sp--; -  dmalloc_touch_svalue(sp); -  if(Pike_compiler->module_index_cache) -  { -  free_mapping(Pike_compiler->module_index_cache); -  Pike_compiler->module_index_cache=0; -  } -  }else{ -  use_module(sp-1); -  pop_stack(); -  } -  -  STACK_LEVEL_DONE(0); -  push_int(0); - } -  - /*! @decl program handle_inherit(string inh) -  *! -  *! Look up an inherit @[inh] in the current program. -  */ - static void f_compilation_handle_inherit(INT32 args) - { -  struct compilation *c = THIS_COMPILATION; -  struct object *handler; -  int fun = -1; -  -  if (args > 1) pop_n_elems(args-1); -  -  ref_push_string(c->lex.current_file); -  if (c->handler && c->handler->prog) { -  ref_push_object(c->handler); -  args = 3; -  } -  else args = 2; -  -  if (((handler = c->handler) && handler->prog && -  ((fun = find_identifier("handle_inherit", handler->prog)) != -1)) || -  ((handler = c->compat_handler) && handler->prog && -  ((fun = find_identifier("handle_inherit", handler->prog)) != -1))) { -  apply_low(handler, fun, args); -  } else { -  apply_external(1, CE_HANDLE_INHERIT_FUN_NUM, args); -  } - } -  - /*! @decl int(0..1) pop_type_attribute(string attribute, type a, type b) -  *! -  *! Type attribute handler. -  *! -  *! Called during type checking when @expr{a <= b@} and -  *! @[a] had the type attribute @[attribute] before the -  *! comparison. -  *! -  *! The default implementation implements the "deprecated" -  *! attribute. -  *! -  *! @returns -  *! Returns @expr{1@} if the type check should be allowed -  *! (ie @expr{__attribute__(attribute, a) <= b@}), and -  *! @expr{0@} (zero) otherwise. -  *! -  *! @seealso -  *! @[push_type_attribute()] -  */ - static void f_compilation_pop_type_attribute(INT32 args) - { -  struct pike_string *attr; -  struct svalue *a, *b; -  struct compilation *c = THIS_COMPILATION; -  struct pike_string *deprecated_string; -  -  get_all_args("pop_type_attribute", args, "%W%*%*", &attr, &a, &b); -  -  if (Pike_compiler->compiler_pass == 2) { -  MAKE_CONST_STRING(deprecated_string, "deprecated"); -  if ((attr == deprecated_string) && -  !(c->lex.pragmas & ID_NO_DEPRECATION_WARNINGS)) { -  push_svalue(a); -  yytype_report(REPORT_WARNING, NULL, 0, NULL, -  NULL, 0, NULL, -  1, "Using deprecated %O value."); -  } -  } -  pop_n_elems(args); -  push_int(1); - } -  - /*! @decl int(0..1) push_type_attribute(string attribute, type a, type b) -  *! -  *! Type attribute handler. -  *! -  *! Called during type checking when @expr{a <= b@} and -  *! @[b] had the type attribute @[attribute] before the -  *! comparison. -  *! -  *! The default implementation implements the "deprecated" -  *! attribute. -  *! -  *! @returns -  *! Returns @expr{1@} if the type check should be allowed -  *! (ie @expr{a <= __attribute__(attribute, b)@}), and -  *! @expr{0@} (zero) otherwise. -  *! -  *! @seealso -  *! @[pop_type_attribute()] -  */ - static void f_compilation_push_type_attribute(INT32 args) - { -  struct pike_string *attr; -  struct svalue *a, *b; -  struct compilation *c = THIS_COMPILATION; -  struct pike_string *deprecated_string; -  -  get_all_args("push_type_attribute", args, "%W%*%*", &attr, &a, &b); -  -  if (Pike_compiler->compiler_pass == 2) { -  MAKE_CONST_STRING(deprecated_string, "deprecated"); -  if ((attr == deprecated_string) && -  !(c->lex.pragmas & ID_NO_DEPRECATION_WARNINGS) && -  !((TYPEOF(*a) == PIKE_T_TYPE) && (a->u.type == zero_type_string))) { -  /* Don't warn about setting deprecated values to zero. */ -  push_svalue(b); -  yytype_report(REPORT_WARNING, NULL, 0, NULL, -  NULL, 0, NULL, -  1, "Using deprecated %O value."); -  } -  } -  pop_n_elems(args); -  push_int(1); - } -  - /*! @decl int(0..1) apply_type_attribute(string attribute, @ -  *! type a, type|void b) -  *! -  *! Type attribute handler. -  *! -  *! @param attribute -  *! Attribute that @[a] had. -  *! -  *! @param a -  *! Type of the value being called. -  *! -  *! @param b -  *! Type of the first argument in the call, or -  *! @[UNDEFINED] if no more arguments. -  *! -  *! Called during type checking when @[a] has been successfully -  *! had a partial evaluation with the argument @[b] and -  *! @[a] had the type attribute @[attribute] before the -  *! evaluation. -  *! -  *! The default implementation implements the "deprecated" -  *! attribute. -  *! -  *! @returns -  *! Returns @expr{1@} if the type check should be allowed -  *! (ie @expr{__attribute__(attribute, a)(b)@}) is valid, -  *! and @expr{0@} (zero) otherwise. -  *! -  *! @seealso -  *! @[pop_type_attribute()], @[push_type_attribute()] -  */ - static void f_compilation_apply_type_attribute(INT32 args) - { -  struct pike_string *attr; -  struct svalue *a, *b = NULL; -  struct compilation *c = THIS_COMPILATION; -  struct pike_string *deprecated_string; -  -  get_all_args("apply_type_attribute", args, "%W%*.%*", &attr, &a, &b); -  -  if (Pike_compiler->compiler_pass == 2) { -  MAKE_CONST_STRING(deprecated_string, "deprecated"); -  if ((attr == deprecated_string) && -  !(c->lex.pragmas & ID_NO_DEPRECATION_WARNINGS) && -  (!b || -  ((TYPEOF(*b) == T_INT) && (SUBTYPEOF(*b) == NUMBER_UNDEFINED) && -  (!b->u.integer)))) { -  /* push_svalue(a); */ -  yytype_report(REPORT_WARNING, NULL, 0, NULL, -  NULL, 0, NULL, -  0, "Calling a deprecated value."); -  } -  } -  pop_n_elems(args); -  push_int(1); - } -  - /*! @decl type(mixed) apply_attribute_constant(string attr, @ -  *! mixed value, @ -  *! type arg_type, @ -  *! void cont_type) -  *! -  *! Handle constant arguments to attributed function argument types. -  *! -  *! @param attr -  *! Attribute that @[arg_type] had. -  *! -  *! @param value -  *! Constant value sent as parameter. -  *! -  *! @param arg_type -  *! Declared type of the function argument. -  *! -  *! @param cont_type -  *! Continuation function type after the current argument. -  *! -  *! This function is called when a function is called -  *! with the constant value @[value] and it has been -  *! successfully matched against @[arg_type], -  *! and @[arg_type] had the type attribute @[attr]. -  *! -  *! This function is typically used to perform specialized -  *! argument checking and to allow for a strengthening -  *! of the function type based on @[value]. -  *! -  *! The default implementation implements the @expr{"sprintf_format"@}, -  *! @expr{"sscanf_format"@} and @expr{"sscanf_76_format"@} attributes. -  *! -  *! @returns -  *! Returns a continuation type if it succeeded in strengthening the type. -  *! -  *! Returns @tt{UNDEFINED@} otherwise (this is not an error indication). -  *! -  *! @seealso -  *! @[pop_type_attribute()], @[push_type_attribute()] -  */ - static void f_compilation_apply_attribute_constant(INT32 args) - { -  struct compilation *c = THIS_COMPILATION; -  struct pike_string *attribute; -  struct pike_string *test; -  struct svalue *sval; -  get_all_args("apply_attribute_constant", args, "%S%*", &attribute, &sval); -  -  if ((TYPEOF(*sval) == T_INT) && !sval->u.integer) { -  pop_n_elems(args); -  push_undefined(); -  return; -  } -  -  MAKE_CONST_STRING(test, "sprintf_format"); -  if (attribute == test) { -  f___handle_sprintf_format(args); -  return; -  } -  MAKE_CONST_STRING(test, "strict_sprintf_format"); -  if (attribute == test) { -  f___handle_sprintf_format(args); -  return; -  } -  MAKE_CONST_STRING(test, "sscanf_format"); -  if (attribute == test) { -  f___handle_sscanf_format(args); -  return; -  } -  MAKE_CONST_STRING(test, "sscanf_76_format"); -  if (attribute == test) { -  f___handle_sscanf_format(args); -  return; -  } -  pop_n_elems(args); -  push_undefined(); - } -  - static void f_compilation__sprintf(INT32 args) - { -  struct compilation *c = THIS_COMPILATION; -  struct string_builder buf; -  init_string_builder_alloc(&buf, 50, 0); -  string_builder_strcat(&buf, "PikeCompiler("); -  if (c->prog) { -  string_builder_strcat(&buf, "\"\", "); -  } else { -  string_builder_strcat(&buf, "UNDEFINED, "); -  } -  if (c->handler) { -  ref_push_object(c->handler); -  string_builder_sprintf(&buf, "%O, ", Pike_sp-1); -  pop_stack(); -  } else { -  string_builder_strcat(&buf, "UNDEFINED, "); -  } -  string_builder_sprintf(&buf, "%d, %d, %s, %s)", -  c->major, c->minor, -  c->target?"target":"UNDEFINED", -  c->placeholder?"placeholder":"UNDEFINED"); -  pop_n_elems(args); -  push_string(finish_string_builder(&buf)); - } -  - /** -  * Fake being called via PikeCompiler()->compile() -  * -  * This function is used to set up the environment for -  * compiling C efuns and modules. -  * -  * Note: Since this is a stack frame, it will be cleaned up -  * automatically on error, so no need to use ONERROR(). -  * -  * Note: Steals a reference from ce. -  */ - static void low_enter_compiler(struct object *ce, int inherit) - { -  struct pike_frame *new_frame = alloc_pike_frame(); - #ifdef PROFILING -  new_frame->children_base = Pike_interpreter.accounted_time; -  new_frame->start_time = get_cpu_time() - Pike_interpreter.unlocked_time; -  new_frame->ident = PC_COMPILE_FUN_NUM; /* Fake call of compile(). */ - #endif /* PROFILING */ -  new_frame->next = Pike_fp; -  new_frame->current_object = ce; -  /* Note: The compilation environment object hangs on this frame, -  * so that it will be freed when the frame dies. -  */ -  new_frame->current_program = ce->prog; -  add_ref(new_frame->current_program); -  new_frame->context = compilation_program->inherits + inherit; -  new_frame->current_storage = ce->storage + new_frame->context->storage_offset; - #ifdef PIKE_DEBUG -  if (new_frame->context->prog != compilation_program) { -  Pike_fatal("Invalid inherit for compilation context (%p != %p).\n", -  new_frame->context->prog, compilation_program); -  } - #endif /* PIKE_DEBUG */ -  new_frame->fun = new_frame->context->identifier_level + PC_COMPILE_FUN_NUM; -  new_frame->locals = Pike_sp; -  new_frame->expendible_offset = 0; -  new_frame->save_sp_offset = 0; -  new_frame->save_mark_sp = Pike_mark_sp; -  new_frame->args = 0; -  new_frame->num_args = 0; -  new_frame->num_locals = 0; -  new_frame->pc = 0; -  new_frame->return_addr = 0; -  new_frame->scope = 0; -  Pike_fp = new_frame; - } -  - PMOD_EXPORT void enter_compiler(struct pike_string *filename, -  INT_TYPE linenumber) - { -  struct object *ce = parent_clone_object(compilation_program, -  compilation_environment, -  CE_PIKE_COMPILER_FUN_NUM, 0); -  struct compilation *c; -  -  low_enter_compiler(ce, 0); -  -  c = THIS_COMPILATION; -  if (filename) { -  free_string(c->lex.current_file); -  copy_shared_string(c->lex.current_file, filename); -  } -  if (linenumber) { -  c->lex.current_line = linenumber; -  } - } -  - /** -  * Reverse the effect of enter_compiler(). -  */ - PMOD_EXPORT void exit_compiler(void) - { - #ifdef PIKE_DEBUG -  if ((Pike_fp->current_program != compilation_program) || -  (Pike_fp->fun != PC_COMPILE_FUN_NUM)) { -  Pike_fatal("exit_compiler(): Frame stack out of whack!\n"); -  } - #endif /* PIKE_DEBUG */ -  POP_PIKE_FRAME(); - } -  - /*! @class CompilerState -  *! -  *! Keeps the state of a single program/class during compilation. -  *! -  *! @note -  *! Not in use yet! -  */ -  - #define THIS_PROGRAM_STATE ((struct program_state *)(Pike_fp->current_storage)) -  - static void program_state_event_handler(int UNUSED(event)) - { - #if 0 -  struct program_state *c = THIS_PROGRAM_STATE; -  switch (event) { -  case PROG_EVENT_INIT: - #define INIT - #include "compilation.h" -  break; -  case PROG_EVENT_EXIT: - #define EXIT - #include "compilation.h" -  break; -  } - #endif /* 0 */ - } -  - /*! @endclass -  */ -  - /*! @endclass -  */ -  - /*! @endclass -  */ -  - /** -  * Strap the compiler by creating the compilation program by hand. -  */ - static void compile_compiler(void) - { -  struct program *p = low_allocate_program(); -  struct program *p2 = compilation_program = low_allocate_program(); -  struct object *co; -  struct inherit *inh; -  -  p->parent_info_storage = -1; -  /* p->event_handler = compilation_env_event_handler; */ -  p->flags |= PROGRAM_HAS_C_METHODS; -  - #if 0 -  /* ADD_STORAGE(struct compilation_env); */ -  p->alignment_needed = ALIGNOF(struct compilation_env); -  p->storage_needed = p->xstorage + sizeof(struct compilation_env); - #endif /* 0 */ -  -  /* Add the initial inherit, this is needed for clone_object() -  * to actually call the event handler, and for low_enter_compiler() -  * to find the storage and context. */ -  p->inherits = inh = xalloc(sizeof(struct inherit)); -  inh->prog = p; -  inh->inherit_level = 0; -  inh->identifier_level = 0; -  inh->parent_identifier = -1; -  inh->parent_offset = OBJECT_PARENT; -  inh->identifier_ref_offset = 0; -  inh->storage_offset = p->xstorage; -  inh->parent = NULL; -  inh->name = NULL; -  p->num_inherits = 1; -  -  /* Force clone_object() to accept the program... -  */ -  p->flags |= PROGRAM_PASS_1_DONE; -  compilation_environment = clone_object(p, 0); -  p->flags &= ~PROGRAM_PASS_1_DONE; -  -  /* Once more, this time for p2... -  */ -  -  p2->parent_info_storage = 0; -  p2->xstorage = sizeof(struct parent_info); -  p2->event_handler = compilation_event_handler; -  p2->flags |= PROGRAM_NEEDS_PARENT|PROGRAM_USES_PARENT|PROGRAM_HAS_C_METHODS; -  -  /* ADD_STORAGE(struct compilation); */ -  p2->alignment_needed = ALIGNOF(struct compilation); -  p2->storage_needed = p2->xstorage + sizeof(struct compilation); -  -  p2->inherits = inh = xalloc(sizeof(struct inherit)); -  inh->prog = p2; -  inh->inherit_level = 0; -  inh->identifier_level = 0; -  inh->parent_identifier = CE_PIKE_COMPILER_FUN_NUM; -  inh->parent_offset = OBJECT_PARENT; -  inh->identifier_ref_offset = 0; -  inh->storage_offset = p2->xstorage; -  inh->parent = NULL; -  inh->name = NULL; -  p2->num_inherits = 1; -  -  p2->flags |= PROGRAM_PASS_1_DONE; -  co = parent_clone_object(p2, compilation_environment, -  CE_PIKE_COMPILER_FUN_NUM, 0); -  p2->flags &= ~PROGRAM_PASS_1_DONE; -  -  low_enter_compiler(co, 0); -  -  low_start_new_program(p, 1, NULL, 0, NULL); -  free_program(p); /* Remove the extra ref we just got... */ -  -  /* NOTE: The order of these identifiers is hard-coded in -  * the CE_*_FUN_NUM definitions in "pike_compiler.h". -  */ -  -  /* NB: Overloaded properly by inherit of Reporter later on. */ -  ADD_FUNCTION("report", f_reporter_report, -  tFuncV(tName("SeverityLevel", tInt03) tStr tIntPos -  tStr tStr, tMix, tVoid),0); -  -  ADD_FUNCTION("compile", f_compilation_env_compile, -  tFunc(tOr(tStr, tVoid) tOr(tObj, tVoid) -  tOr(tInt, tVoid) tOr(tInt, tVoid) -  tOr(tPrg(tObj), tVoid) tOr(tObj, tVoid), -  tPrg(tObj)), 0); -  -  ADD_FUNCTION("resolv", f_compilation_env_resolv, -  tFunc(tStr tStr tObj, tMix), 0); -  -  low_start_new_program(p2, 1, NULL, 0, NULL); -  -  /* low_start_new_program() has zapped the inherit we created -  * for p2 above, so we need to repair the frame pointer. -  */ -  Pike_fp->context = p2->inherits; -  -  /* MAGIC! We're now executing inside the object being compiled, -  * and have done sufficient stuff to be able to call and use -  * the normal program building functions. -  */ -  -  /* NOTE: The order of these identifiers is hard-coded in -  * the PC_*_FUN_NUM definitions in "pike_compiler.h". -  */ -  -  ADD_FUNCTION("report", f_compilation_report, -  tFuncV(tName("SeverityLevel", tInt03) tStr tIntPos -  tStr tStr, tMix, tVoid),0); -  -  ADD_FUNCTION("compile", f_compilation_compile, -  tFunc(tNone, tPrg(tObj)), 0); -  -  ADD_FUNCTION("resolv", f_compilation_resolv, -  tFunc(tStr tStr tObj, tMix), 0); -  -  ADD_FUNCTION("create", f_compilation_create, -  tFunc(tOr(tStr, tVoid) tOr(tObj, tVoid) -  tOr(tInt, tVoid) tOr(tInt, tVoid) -  tOr(tPrg(tObj), tVoid) tOr(tObj, tVoid), tVoid), -  ID_PROTECTED); -  -  ADD_FUNCTION("get_compilation_handler", -  f_compilation_get_compilation_handler, -  tFunc(tInt tInt, tObj), 0); -  -  ADD_FUNCTION("get_default_module", f_compilation_get_default_module, -  tFunc(tNone, tOr(tMap(tStr, tMix), tObj)), 0); -  -  ADD_FUNCTION("change_compiler_compatibility", -  f_compilation_change_compiler_compatibility, -  tFunc(tInt tInt, tVoid), 0); -  -  ADD_FUNCTION("handle_inherit", f_compilation_handle_inherit, -  tFunc(tStr, tPrg(tObj)), 0); -  -  ADD_FUNCTION("pop_type_attribute", f_compilation_pop_type_attribute, -  tFunc(tStr tType(tMix) tType(tMix), tInt01), 0); -  -  ADD_FUNCTION("push_type_attribute", f_compilation_push_type_attribute, -  tFunc(tStr tType(tMix) tType(tMix), tInt01), 0); -  -  ADD_FUNCTION("apply_type_attribute", f_compilation_apply_type_attribute, -  tFunc(tStr tType(tMix) tOr(tType(tMix), tVoid), tInt01), 0); -  -  ADD_FUNCTION("apply_attribute_constant", -  f_compilation_apply_attribute_constant, -  tFunc(tStr tMix tType(tMix) tType(tFunction), -  tType(tFunction)), 0); -  -  ADD_FUNCTION("_sprintf", f_compilation__sprintf, -  tFunc(tInt tOr(tMap(tStr, tMix), tVoid), tStr), ID_PROTECTED); -  -  start_new_program(); -  -  ADD_STORAGE(struct program_state); -  Pike_compiler->new_program->event_handler = program_state_event_handler; -  Pike_compiler->new_program->flags |= -  PROGRAM_NEEDS_PARENT|PROGRAM_USES_PARENT|PROGRAM_HAS_C_METHODS; -  -  /* Alias for report above. */ -  low_define_alias(NULL, NULL, 0, 1, PC_REPORT_FUN_NUM); -  -  end_class("CompilerState", 0); -  -  /* Map some of our variables so that the gc can find them. */ -  PIKE_MAP_VARIABLE("prog", OFFSETOF(compilation, prog), -  tStr, PIKE_T_STRING, ID_HIDDEN); -  PIKE_MAP_VARIABLE("handler", OFFSETOF(compilation, handler), -  tObj, PIKE_T_OBJECT, 0); -  PIKE_MAP_VARIABLE("compat_handler", OFFSETOF(compilation, compat_handler), -  tObj, PIKE_T_OBJECT, 0); -  PIKE_MAP_VARIABLE("target", OFFSETOF(compilation, target), -  tPrg(tObj), PIKE_T_PROGRAM, ID_HIDDEN); -  PIKE_MAP_VARIABLE("placeholder", OFFSETOF(compilation, placeholder), -  tObj, PIKE_T_OBJECT, ID_HIDDEN); -  PIKE_MAP_VARIABLE("p", OFFSETOF(compilation, p), -  tPrg(tObj), PIKE_T_PROGRAM, ID_HIDDEN); -  PIKE_MAP_VARIABLE("current_file", OFFSETOF(compilation, lex.current_file), -  tStr, PIKE_T_STRING, ID_HIDDEN); -  PIKE_MAP_VARIABLE("default_module", OFFSETOF(compilation, default_module), -  tOr(tMap(tStr,tMix),tObj), PIKE_T_MIXED, 0); -  -  /* end_class()/end_program() adds the parent_info storage once more. -  * Remove the one we added above, so that we don't get it double. -  */ -  p2->xstorage = 0; -  -  end_class("PikeCompiler", 0); -  /* end_class()/end_program() has zapped the inherit once again, -  * so we need to repair the frame pointer. -  */ -  Pike_fp->context = compilation_program->inherits; -  -  ADD_FUNCTION("get_compilation_handler", -  f_compilation_env_get_compilation_handler, -  tFunc(tInt tInt, tObj), 0); -  -  ADD_FUNCTION("get_default_module", -  f_compilation_env_get_default_module, -  tFunc(tNone, tOr(tMap(tStr, tMix), tObj)), 0); -  -  ADD_FUNCTION("handle_inherit", f_compilation_env_handle_inherit, -  tFunc(tStr tStr tOr(tObj, tVoid), tPrg(tObj)), 0); -  -  /* Reporter */ -  start_new_program(); -  { -  struct svalue type_value; -  -  ADD_FUNCTION("report", f_reporter_report, -  tFuncV(tName("SeverityLevel", tInt03) tStr tIntPos -  tStr tStr, tMix, tVoid),0); -  -  /* enum SeverityLevel { NOTICE, WARNING, ERROR, FATAL } */ -  SET_SVAL(type_value, PIKE_T_TYPE, 0, type, -  CONSTTYPE(tName("SeverityLevel", tInt03))); -  simple_add_constant("SeverityLevel", &type_value, 0); -  free_svalue(&type_value); -  -  add_integer_constant("NOTICE", REPORT_NOTICE, 0); -  add_integer_constant("WARNING", REPORT_WARNING, 0); -  add_integer_constant("ERROR", REPORT_ERROR, 0); -  add_integer_constant("FATAL", REPORT_FATAL, 0); -  -  reporter_program = end_program(); -  } -  add_global_program("Reporter", reporter_program); -  -  low_inherit(reporter_program, NULL, -1, 0, 0, 0); -  -  start_new_program(); -  Pike_compiler->new_program->event_handler = -  compiler_environment_lock_event_handler; -  Pike_compiler->new_program->flags |= PROGRAM_DESTRUCT_IMMEDIATE; -  end_class("lock", 0); -  -  compilation_env_program = end_program(); -  -  add_global_program("CompilerEnvironment", compilation_env_program); -  -  exit_compiler(); -  -  ref_push_object(compilation_environment); -  low_add_constant("DefaultCompilerEnvironment", Pike_sp-1); -  pop_stack(); - } -  - struct program *compile(struct pike_string *aprog, -  struct object *ahandler,/* error handler */ -  int amajor, int aminor, -  struct program *atarget, -  struct object *aplaceholder) - { -  int delay, dependants_ok = 1; -  struct program *ret; - #ifdef PIKE_DEBUG -  ONERROR tmp; - #endif -  struct object *ce; -  struct compilation *c; -  -  /* FIXME! */ -  -  Pike_fatal("Old C-level compile() function called!\n"); -  -  CDFPRINTF("th(%ld) %p compile() enter, placeholder=%p\n", -  (long) th_self(), atarget, aplaceholder); -  -  ce = clone_object(compilation_program, 0); -  c = (struct compilation *)ce->storage; -  -  debug_malloc_touch(c); -  -  verify_supporters(); -  -  c->p = NULL; -  add_ref(c->prog=aprog); -  if((c->handler=ahandler)) add_ref(ahandler); -  c->major=amajor; -  c->minor=aminor; -  if((c->target=atarget)) add_ref(atarget); -  if((c->placeholder=aplaceholder)) add_ref(aplaceholder); -  SET_SVAL(c->default_module, T_INT, NUMBER_NUMBER, integer, 0); -  -  if (c->handler) -  { -  if (safe_apply_handler ("get_default_module", c->handler, NULL, -  0, BIT_MAPPING|BIT_OBJECT|BIT_ZERO)) { -  if(SAFE_IS_ZERO(Pike_sp-1)) -  { -  pop_stack(); -  ref_push_mapping(get_builtin_constants()); -  } -  } else { -  ref_push_mapping(get_builtin_constants()); -  } -  }else{ -  ref_push_mapping(get_builtin_constants()); -  } -  free_svalue(& c->default_module); -  move_svalue (&c->default_module, --Pike_sp); -  - #ifdef PIKE_DEBUG -  SET_ONERROR(tmp, fatal_on_error,"Compiler exited with longjump!\n"); - #endif -  -  lock_pike_compiler(); - #ifdef PIKE_THREADS -  c->saved_lock_depth = lock_depth; - #endif -  -  init_supporter(& c->supporter, -  (supporter_callback *) call_delayed_pass2, -  (void *)c); -  -  delay=run_pass1(c); -  dependants_ok = call_dependants(& c->supporter, !!c->p ); - #ifdef PIKE_DEBUG -  /* FIXME */ -  UNSET_ONERROR(tmp); - #endif -  -  if(delay) -  { -  CDFPRINTF("th(%ld) %p compile() finish later, placeholder=%p.\n", -  (long) th_self(), c->target, c->placeholder); -  /* finish later */ -  add_ref(c->p); -  verify_supporters(); -  return c->p; /* freed later */ -  }else{ -  CDFPRINTF("th(%ld) %p compile() finish now\n", -  (long) th_self(), c->target); -  /* finish now */ -  if(c->p) run_pass2(c); -  debug_malloc_touch(c); -  run_cleanup(c,0); -  -  ret=c->p; -  /* FIXME: Looks like ret should get an extra ref here, but I'm not -  * sure. Besides, this function isn't used anymore. /mast */ -  -  debug_malloc_touch(c); -  free_object(ce); -  -  if (!dependants_ok) { -  CDFPRINTF("th(%ld) %p compile() reporting failure " -  "since a dependant failed.\n", -  (long) th_self(), c->target); -  if (ret) free_program(ret); -  throw_error_object(fast_clone_object(compilation_error_program), 0, 0, 0, -  "Compilation failed.\n"); -  } -  if(!ret) { -  CDFPRINTF("th(%ld) %p compile() failed.\n", -  (long) th_self(), c->target); -  throw_error_object(fast_clone_object(compilation_error_program), 0, 0, 0, -  "Compilation failed.\n"); -  } -  debug_malloc_touch(ret); - #ifdef PIKE_DEBUG -  if (a_flag > 2) { -  dump_program_tables(ret, 0); -  } - #endif /* PIKE_DEBUG */ -  verify_supporters(); -  return ret; -  } - } -  +    PMOD_EXPORT int low_quick_add_function(struct pike_string * name_tmp,    void (*cfun)(INT32),    const char *type,    int UNUSED(type_length),    unsigned flags,    unsigned opt_flags)   {    int ret;    struct pike_type *type_tmp;    union idptr tmp;
pike.git/src/program.c:11226:    mapping_insert(lfun_ids, &key, &id);       SET_SVAL(val, T_TYPE, 0, type, make_pike_type(raw_lfun_types[i]));    mapping_insert(lfun_types, &key, &val);    free_type(val.u.type);    }       lfun_getter_type_string = make_pike_type(tFuncV(tNone, tVoid, tMix));    lfun_setter_type_string = make_pike_type(tFuncV(tZero, tVoid, tVoid));    - #ifdef PIKE_THREADS -  co_init(&Pike_compiler_cond); - #endif +  init_pike_compiler();    -  compile_compiler(); -  +     enter_compiler(NULL, 0);       start_new_program();    debug_malloc_touch(Pike_compiler->fake_object);    debug_malloc_touch(Pike_compiler->fake_object->storage);    ADD_STORAGE(struct pike_trampoline);    ADD_FUNCTION("`()",apply_trampoline,tFunction,0);    ADD_FUNCTION("`!",not_trampoline,tFunc(tVoid,tInt),0);    ADD_FUNCTION("_sprintf", sprintf_trampoline,    tFunc(tInt tOr(tMapping,tVoid),tStr), 0);
pike.git/src/program.c:11346: Inside #if defined(DO_PIKE_CLEANUP)
   placeholder_object=0;    }       if(placeholder_program)    {    free_program(placeholder_program);    placeholder_program=0;    }   #endif    -  if (compilation_program) { -  free_program(compilation_program); -  compilation_program = 0; +  cleanup_pike_compiler();   } -  if (compilation_environment) { -  free_object(compilation_environment); -  compilation_environment = 0; -  } -  if (compilation_env_program) { -  free_program(compilation_env_program); -  compilation_env_program = 0; -  } -  if (reporter_program) { -  free_program(reporter_program); -  reporter_program = 0; -  } - #ifdef PIKE_THREADS -  co_destroy(&Pike_compiler_cond); - #endif - } +          PMOD_EXPORT void visit_program (struct program *p, int action, void *extra)   {    visit_enter(p, T_PROGRAM, extra);    switch (action & VISIT_MODE_MASK) {   #ifdef PIKE_DEBUG    default:    Pike_fatal ("Unknown visit action %d.\n", action);    case VISIT_NORMAL: