master.pike.in

/* $Id: master.pike.in,v 1.61 1999/10/15 23:07:40 hubbe Exp $
 * 
 * Master-file for Pike.
 *
 * Based on master.pike 1.67.
 */

// Some configurable parameters useful for debugging

#define PIKE_AUTORELOAD

// Used by describe_backtrace() et al.
#if !defined(BT_MAX_STRING_LEN) || (BT_MAX_STRING_LEN <= 0)
#undef BT_MAX_STRING_LEN
#define BT_MAX_STRING_LEN	255
#endif /* !defined(BT_MAX_STRING_LEN) || (BT_MAX_STRING_LEN <= 0) */

/*
 * Functions begin here.
 */

int is_absolute_path(string p)
{
#ifdef __NT__
  p=replace(p,"\\","/");
  if(sscanf(p,"%[a-zA-Z]:",string s) && sizeof(s)==1)
    return 1;
#define IS_ABSOLUTE_PATH is_absolute_path
#else
#define IS_ABSOLUTE_PATH(X) ((X)[0]=='/')
#endif
  return p[0]=='/';
}

string *explode_path(string p)
{
#ifdef __NT__
  p=replace(p,"\\","/");
#define EXPLODE_PATH(X) (replace((X),"\\","/")/"/")
#else
#define EXPLODE_PATH(X) ((X)/"/")
#endif
  return p/"/";
}

string dirname(string x)
{
  string *tmp=EXPLODE_PATH(x);
  return tmp[..sizeof(tmp)-2]*"/";
}

string basename(string x)
{
  string *tmp=EXPLODE_PATH(x);
  return tmp[-1];
}
#define DIRNAME dirname
#define BASENAME(X) (EXPLODE_PATH(X)[-1])

#define GETCWD_CACHE
#define FILE_STAT_CACHE

#define UNDEFINED (([])[0])
#define error(X) throw( ({ (X), backtrace()[0..sizeof(backtrace())-2] }) )

string describe_backtrace(mixed *trace);
object low_cast_to_object(string oname, string current_file);

string *pike_include_path=({});
string *pike_module_path=({});
string *pike_program_path=({});
int want_warnings;

#ifdef PIKE_AUTORELOAD

int autoreload_on;
int newest;

#define AUTORELOAD_CHECK_FILE(X) \
   if(autoreload_on) if(mixed fnord=master_file_stat(X)) if(fnord[3]>newest) newest=fnord[3];

#define AUTORELOAD_BEGIN() \
    int ___newest=newest;  \
    newest=0
    

#define AUTORELOAD_FINISH(VAR, CACHE, FILE)		\
   if(autoreload_on) {                                  \
     if(CACHE [ FILE ] && newest <= load_time[FILE]) {	\
        VAR = CACHE [ FILE ]; 				\
      }                                                 \
    }                                                   \
    load_time[FILE]=time();				\
    if(___newest > newest) newest=___newest;


mapping(string:int) load_time=([]);
#else

#define AUTORELOAD_CHECK_FILE(X)
#define AUTORELOAD_BEGIN()
#define AUTORELOAD_FINISH(VAR,CACHE,FILE)

#endif

program compile_string(string data, void|string name)
{
  return compile(cpp(data,name||"-"));
}

program compile_file(string file)
{
  AUTORELOAD_CHECK_FILE(file);
  return compile(cpp(_static_modules.files()->Fd(file,"r")->read(),file, 1));
}


#ifdef GETCWD_CACHE
string current_path;
int cd(string s)
{
  current_path=0;
  return predef::cd(s);
}

string getcwd()
{
  return current_path || (current_path=predef::getcwd());
}
#endif

string combine_path_with_cwd(string path)
{
  return combine_path(IS_ABSOLUTE_PATH(path)?"/":getcwd(),path);
}

#ifdef FILE_STAT_CACHE

#define FILE_STAT_CACHE_TIME 20

int invalidate_time;
mapping(string:multiset(string)) dir_cache = ([]);

mixed *master_file_stat(string x)
{
  string file, dir=combine_path_with_cwd(x);

  file=BASENAME(dir);
  dir=DIRNAME(dir);

  multiset(string) d;
  if(time() > invalidate_time)
  {
    dir_cache=([]);
    invalidate_time=time()+FILE_STAT_CACHE_TIME;
  }
  if(zero_type(d=dir_cache[dir]))
  {
    if(string *tmp=get_dir(dir))
    {
      d=dir_cache[dir]=aggregate_multiset(@tmp);
    }else{
      dir_cache[dir]=0;
    }
  }
  
  if(d && !d[file]) return 0;

  return predef::file_stat(x);
}
#else
#define master_file_stat file_stat
#endif

mapping (string:string) environment=([]);


mixed getenv(string|void s)
{
  if(!s) return environment;
  return environment[s];
}

void putenv(string var, string val)
{
  environment[var]=val;
}


void add_include_path(string tmp)
{
  tmp=combine_path_with_cwd(tmp);
  pike_include_path-=({tmp});
  pike_include_path=({tmp})+pike_include_path;
}

void remove_include_path(string tmp)
{
  tmp=combine_path_with_cwd(tmp);
  pike_include_path-=({tmp});
}

void add_module_path(string tmp)
{
  tmp=combine_path_with_cwd(tmp);
  pike_module_path-=({tmp});
  pike_module_path=({tmp})+pike_module_path;
}


void remove_module_path(string tmp)
{
  tmp=combine_path_with_cwd(tmp);
  pike_module_path-=({tmp});
}


void add_program_path(string tmp)
{
  tmp=combine_path_with_cwd(tmp);
  pike_program_path-=({tmp});
  pike_program_path=({tmp})+pike_program_path;
}


void remove_program_path(string tmp)
{
  tmp=combine_path_with_cwd(tmp);
  pike_program_path-=({tmp});
}


mapping (string:program) programs=(["/master":object_program(this_object())]);

#define capitalize(X) (upper_case((X)[..0])+(X)[1..])

static program low_findprog(string pname, string ext)
{
  program ret;
  array s;
  string fname=pname+ext;

#ifdef PIKE_AUTORELOAD
  if(!autoreload_on || load_time[fname]>=time())
#endif
  {
    if(ret=programs[fname]) return ret;
  }

  if( (s=master_file_stat(fname))  && s[1]>=0 )
  {
    AUTORELOAD_BEGIN();
    switch(ext)
    {
    case "":
    case ".pike":
      if(array s2=master_file_stat(fname+".o"))
      {	
	if(s2[1]>=0 && s2[3]>=s[3])
	{
	  mixed err=catch {
            AUTORELOAD_CHECK_FILE(fname+".o");
	    return programs[fname]=decode_value(_static_modules.files()->Fd(fname+".o","r")->read(),Codec());
	  };
	  if(want_warnings)
	    werror("Failed to decode %s.o\n",fname);
	}
      }
      
      
      if ( mixed e=catch { ret=compile_file(fname); } )
      {
	if(arrayp(e) &&
	   sizeof(e)==2 &&
	   arrayp(e[1]) &&
	   sizeof(e[1]) == sizeof(backtrace()))
	  e[1]=({});
	throw(e);
      }
      break;
#if constant(load_module)
    case ".so":
      if (fname == "") {
	werror(sprintf("low_find_prog(\"%s\", \"%s\") => load_module(\"\")\n"
		       "%s\n", pname, ext, describe_backtrace(backtrace())));
      }
      ret=load_module(fname);
#endif /* load_module */
    }

    AUTORELOAD_FINISH(ret,programs,fname);
    
    return programs[fname]=ret;
  }else{
    return UNDEFINED;
  }
}

static program findprog(string pname, string ext)
{
  switch(ext)
  {
  case ".pike":
  case ".so":
    return low_findprog(pname,ext);

  default:
    pname+=ext;
    return
      low_findprog(pname,"") ||
      low_findprog(pname,".pike") ||
      low_findprog(pname,".so");
  }
}

/* This function is called when the driver wants to cast a string
 * to a program, this might be because of an explicit cast, an inherit
 * or a implict cast. In the future it might receive more arguments,
 * to aid the master finding the right program.
 */
program cast_to_program(string pname, string current_file)
{
  string ext;
  string nname;
  array(string) tmp=EXPLODE_PATH(pname);

  if(sscanf(reverse(tmp[-1]),"%s.%s",ext, nname))
  {
    ext="."+reverse(ext);
    tmp[-1]=reverse(nname);
    pname=tmp*"/";
  }else{
    ext="";
  }
  if(IS_ABSOLUTE_PATH(pname))
  {
    pname=combine_path("/",pname);
    return findprog(pname,ext);
  }else{
    string cwd;
    if(current_file)
    {
      cwd=DIRNAME(current_file);
    }else{
      cwd=getcwd();
    }

    if(program ret=findprog(combine_path(cwd,pname),ext))
      return ret;

    foreach(pike_program_path, string path)
      if(program ret=findprog(combine_path(path,pname),ext))
	return ret;

    return 0;
  }
}

/* This function is called when an error occurs that is not caught
 * with catch(). It's argument consists of:
 * ({ error_string, backtrace }) where backtrace is the output from the
 * backtrace() efun.
 */
void handle_error(mixed *trace)
{
  predef::trace(0);
  if(mixed x=catch {
    werror(describe_backtrace(trace));
  })
  {
    werror("Error in handle_error in master object:\n");
    werror("%O\nOriginal error:\n%O\n",x,trace);
  }
  
}

object new(mixed prog, mixed ... args)
{
  if(stringp(prog))
  {
    if(program p=cast_to_program(prog,backtrace()[-2][0]))
      return p(@args);
    else
      error(sprintf("new: failed to find program %s.\n",prog));
  }
  return prog(@args);
}

multiset mkmultiset(array a)
{
  return aggregate_multiset(@a);
}

function clone = new;

/* This array contains the names of the functions
 * that a replacing master-object may want to override.
 */
constant master_efuns = ({
  "basename",
  "dirname",
  "is_absolute_path",
  "explode_path",

  "compile_string",
  "compile_file",
  "add_include_path",
  "remove_include_path",
  "add_module_path",
  "remove_module_path",
  "add_program_path",
  "remove_program_path",
  "describe_backtrace",
  "mkmultiset",
  "new",
  "clone",

  "getenv",
  "putenv",

#ifdef GETCWD_CACHE
  "cd",
  "getcwd",
#endif
});

/* Note that create is called before add_precompiled_program
 */
void create()
{
  object o = this_object();

  foreach(master_efuns, string e) {
    if (o[e]) {
      add_constant(e, o[e]);
    } else {
      throw(({ sprintf("Function %O is missing from master.pike.\n", e),
	       backtrace() }));
    }
  }

  add_constant("strlen", sizeof);
  add_constant("UNDEFINED", UNDEFINED);
  add_constant("write", _static_modules.files()->_stdout->write);

#if "share_prefix"[0]!=''
  // add path for architecture-dependant files
  add_include_path("share_prefix/include");
  add_module_path("share_prefix/modules");
#endif

#if "lib_prefix"[0]!=''
  // add path for architecture-dependant files
  add_include_path("lib_prefix/include");
  add_module_path("lib_prefix/modules");
#endif

  random_seed(time() + (getpid() * 0x11111111));
}

/*
 * This function is called whenever a inherit is called for.
 * It is supposed to return the program to inherit.
 * The first argument is the argument given to inherit, and the second
 * is the file name of the program currently compiling. Note that the
 * file name can be changed with #line, or set by compile_string, so
 * it can not be 100% trusted to be a filename.
 * previous_object(), can be virtually anything in this function, as it
 * is called from the compiler.
 */
program handle_inherit(string pname, string current_file)
{
  return cast_to_program(pname, current_file);
}

mapping (program:object) objects=([object_program(this_object()):this_object()]);

object low_cast_to_object(string oname, string current_file)
{
  program p;
  object o;

  p=cast_to_program(oname, current_file);
  if(!p) return 0;
  if(!(o=objects[p])) o=objects[p]=p();
  return o;
}

/* This function is called when the drivers wants to cast a string
 * to an object because of an implict or explicit cast. This function
 * may also receive more arguments in the future.
 */
object cast_to_object(string oname, string current_file)
{
  if(object o=low_cast_to_object(oname, current_file))
    return o;
  error("Cast to object failed\n");
}

class dirnode
{
  string dirname;
  mixed module;
  mapping cache=([]);

  void create(string name)
  {
    dirname=name;

    if(module=findmodule(dirname+"/module"))
      if(mixed tmp=module->_module_value)
	module=tmp;
  }

  object|program ind(string index)
  {
    if(module) if(object o=module[index]) return o;

    index = dirname+"/"+index;
    if(object o=findmodule(index))
    {
      if(mixed tmp=o->_module_value) o=tmp;
      return o;
    }
    return cast_to_program(index,0);
  }

  object|program `[](string index)
  {
    mixed ret;
    if(!zero_type(ret=cache[index]))
    {
      if(ret) return ret;
      return UNDEFINED;
    }
    return cache[index]=ind(index);
  }

  int _cache_full;
  void fill_cache()
  {
#ifdef RESOLV_DEBUG
    werror(describe_backtrace(({ sprintf("Filling cache in dirnode %O\n",
					 dirname),
				 backtrace() })));
#endif /* RESOLV_DEBUG */
    if (_cache_full) {
      return;
    }

    if (module) {
      foreach(indices(module), string index) {
	cache[index] = module[index];
      }
    }

    foreach(get_dir(dirname), string fname) {
      catch {
	if (((< ".pike", ".pmod" >)[fname[sizeof(fname)-5..]]) &&
	    !zero_type(`[](fname[..sizeof(fname)-6]))) {
	  continue;
	}
      };
      catch {
	if ((fname[sizeof(fname)-3..] == ".so") &&
	    !zero_type(`[](fname[..sizeof(fname)-4]))) {
	  continue;
	}
      };
    }
    _cache_full = 1;
  }
  array(string) _indices()
  {
    fill_cache();
    return indices(filter(cache, lambda(mixed x){ return x; }));
  }
  array(mixed) _values()
  {
    fill_cache();
    return values(cache)-({0});
  }
};

class joinnode
{
  class ZERO_TYPE {};
  array(object|mapping) joined_modules;
  mapping cache=([]);

  void create(array(object|mapping) _joined_modules)
  {
    joined_modules = _joined_modules;
  }

  object|mapping ind(string index)
  {
    array(mixed) res = ({});
    foreach(joined_modules, object|mapping o) {
      mixed ret;
      if (!zero_type(ret = o[index])) {
	if (objectp(ret = o[index]) &&
	    (< joinnode, dirnode >)[object_program(ret)]) {
	  // Only join directorynodes (or joinnodes).
	  res += ({ ret });
	} else if (!sizeof(res)) {
	  return(ret);
	} else {
	  // Ignore
	  werror(sprintf("Ignoring index %s: %t\n", index, ret));
	  continue;
	}
      }
    }
    if (sizeof(res) > 1) {
      return joinnode(res);
    } else if (sizeof(res)) {
      return res[0];
    }
    return UNDEFINED;
  }

  object|mapping `[](string index)
  {
    object|mapping ret;
    if (!zero_type(ret = cache[index])) {
      if (ret != ZERO_TYPE) {
	return ret;
      }
      return UNDEFINED;
    }
    ret = ind(index);
    if (zero_type(ret)) {
      cache[index] = ZERO_TYPE;
    } else {
      cache[index] = ret;
    }
    return ret;
  }
  int _cache_full;
  void fill_cache()
  {
#ifdef RESOLV_DEBUG
    werror(describe_backtrace(({ "Filling cache in joinnode\n",
				 backtrace() })));
#endif /* RESOLV_DEBUG */
    if (_cache_full) {
      return;
    }
    foreach(joined_modules, object|mapping o) {
      foreach(indices(o), string index) {
	if (zero_type(cache[index])) {
	  `[](index);
	}
      }
    }
    _cache_full = 1;
  }
  array(string) _indices()
  {
    fill_cache();
    return indices(cache);
  }
  array(mixed) _values()
  {
    fill_cache();
    return values(cache);
  }
};

// Variables mustn't be static to allow for replace_master().
//	/grubba 1998-04-10
mapping(string:mixed) fc=([]);

object findmodule(string fullname)
{
  mixed *stat;
  object o;
  if(!zero_type(o=fc[fullname]))
  {
    return o;
  }

  if(mixed *stat=master_file_stat(fullname+".pmod"))
  {
    if(stat[1]==-2)
      return fc[fullname]=dirnode(fullname+".pmod");
  }

  if(o=low_cast_to_object(fullname+".pmod","/."))
    return fc[fullname]=o;
    
#if constant(load_module)
  if(master_file_stat(fullname+".so"))
    return fc[fullname]=low_cast_to_object(fullname,"/.");
#endif

  return fc[fullname]=UNDEFINED;
}

mixed handle_import(string what, string|void current_file)
{
  string *tmp,path;
  if(current_file)
  {
    tmp=EXPLODE_PATH(current_file);
    tmp[-1]=what;
    path=combine_path_with_cwd( tmp*"/");
  }
  return fc[path]=dirnode(path);
}

mixed resolv_base(string identifier, string|void current_file)
{
  array(mixed) tmp = ({});
  foreach(pike_module_path, string path)
  {
    string file=combine_path(path,identifier);
    if(mixed ret=findmodule(file)) {
      if ((objectp(ret)) &&
	  (< joinnode, dirnode >)[object_program(ret)]) {
	if (mixed new_ret = ret->_module_value) {
	  ret = new_ret;
	}
	tmp += ({ ret });
      } else {
	if (mixed new_ret = ret->_module_value) {
	  ret = new_ret;
	}
	if (!sizeof(tmp)) {
	  return ret;
	} else {
	  // Ignore
	  werror(sprintf("Ignoring file %O: %t for identifier %O\n",
			 file, ret, identifier));
	  continue;
	}
      }
    }
  }
  if (sizeof(tmp)) {
    if (sizeof(tmp) == 1) {
      return(tmp[0]);
    }
    return joinnode(tmp);
  }
  return UNDEFINED;
}

mixed resolv(string identifier, string|void current_file)
{
  array(string) tmp=identifier/".";
  mixed ret=resolv_base(tmp[0]);
  foreach(tmp[1..],string index) ret=ret[index];
  return ret;
}

// These are useful if you want to start other Pike processes
// with the same options as this one was started with.
string _pike_file_name;
string _master_file_name;

/* This function is called when all the driver is done with all setup
 * of modules, efuns, tables etc. etc. and is ready to start executing
 * _real_ programs. It receives the arguments not meant for the driver
 * and an array containing the environment variables on the same form as
 * a C program receives them.
 */
void _main(string *orig_argv, string *env)
{
  string *argv=copy_value(orig_argv);
  int i,debug,trace;
  object script;
  object tmp;
  string a,b;
  mixed *q;

  _pike_file_name = orig_argv[0];

  foreach(env,a)
    {
      if(sscanf(a,"%s=%s",a,b))
      {
	if(a=="") // Special hack for NT
	{
	  sscanf(b,"%s=%s",a,b);
	  a="="+a;
	}
	environment[a]=b;
      }else{
	werror("Broken environment var %s\n",a);
      }		
    }



#ifndef NOT_INSTALLED
  q=(getenv("PIKE_INCLUDE_PATH")||"")/":"-({""});
  for(i=sizeof(q)-1;i>=0;i--) add_include_path(q[i]);

  q=(getenv("PIKE_PROGRAM_PATH")||"")/":"-({""});
  for(i=sizeof(q)-1;i>=0;i--) add_program_path(q[i]);

  q=(getenv("PIKE_MODULE_PATH")||"")/":"-({""});
  for(i=sizeof(q)-1;i>=0;i--) add_module_path(q[i]);
#endif
  
  if(sizeof(argv)>1 && sizeof(argv[1]) && argv[1][0]=='-')
  {
    tmp=resolv("Getopt");

    if (!tmp) {
      werror("master.pike: Couldn't resolv Getopt module.\n"
	     "Is your PIKE_MODULE_PATH environment variable set correctly?\n");
      exit(1);
    }
    
    q=tmp->find_all_options(argv,({
      ({"version",tmp->NO_ARG,({"-v","--version"})}),
      ({"help",tmp->NO_ARG,({"-h","--help"})}),
      ({"execute",tmp->HAS_ARG,({"-e","--execute"})}),
      ({"preprocess",tmp->HAS_ARG,({"-E","--preprocess"})}),
      ({"modpath",tmp->HAS_ARG,({"-M","--module-path"})}),
      ({"ipath",tmp->HAS_ARG,({"-I","--include-path"})}),
      ({"ppath",tmp->HAS_ARG,({"-P","--program-path"})}),
      ({"showpaths",tmp->NO_ARG,"--show-paths"}),
      ({"warnings",tmp->NO_ARG,({"-w","--warnings"})}),
#ifdef PIKE_AUTORELOAD
      ({"autoreload",tmp->NO_ARG,({"--autoreload"})}),
#endif
      ({"master",tmp->HAS_ARG,"-m"}),
      ({"compiler_trace",tmp->NO_ARG,"--compiler-trace"}),
      ({"debug",tmp->MAY_HAVE_ARG,"--debug",0,1}),
      ({"trace",tmp->MAY_HAVE_ARG,"--trace",0,1}),
      ({"ignore",tmp->MAY_HAVE_ARG,"-Dqdatpl",0,1}),
      ({"ignore",tmp->HAS_ARG,"-s"}),
    }), 1);
    
    /* Parse -M and -I backwards */
    for(i=sizeof(q)-1;i>=0;i--)
    {
      switch(q[i][0])
      {
#ifdef PIKE_AUTORELOAD
      case "autoreload":
	autoreload_on++;
#endif

      case "debug":
	debug+=(int)q[i][1];
	break;

#if constant(_compiler_trace)
      case "compiler_trace":
	_compiler_trace(1);
	break;
#endif /* constant(_compiler_trace) */

      case "trace":
	trace+=(int)q[i][1];
	break;

      case "modpath":
	add_module_path(q[i][1]);
	break;
	
      case "ipath":
	add_include_path(q[i][1]);
	break;
	
      case "ppath":
	add_program_path(q[i][1]);
	break;

      case "warnings":
	want_warnings++;
	break;

      case "master":
	_master_file_name = q[i][1];
	break;
      }
    }
    
    foreach(q, mixed *opts)
    {
      switch(opts[0])
      {
      case "version":
	werror(version() + " Copyright (C) 1994-1997 Fredrik Hbinette\n"
	       "Pike comes with ABSOLUTELY NO WARRANTY; This is free software and you are\n"
	       "welcome to redistribute it under certain conditions; Read the files\n"
	       "COPYING and DISCLAIMER in the Pike distribution for more details.\n");
	exit(0);
	
      case "help":
	werror("Usage: pike [-driver options] script [script arguments]\n"
	       "Driver options include:\n"
	       " -I --include-path=<p>: Add <p> to the include path\n"
	       " -M --module-path=<p> : Add <p> to the module path\n"
	       " -P --program-path=<p>: Add <p> to the program path\n"
	       " -e --execute=<cmd>   : Run the given command instead of a script.\n"
	       " -h --help            : see this message\n"
	       " -v --version         : See what version of pike you have.\n"
	       " --show-paths         : See the paths and master that pike uses.\n"
	       " -s#                  : Set stack size\n"
	       " -m <file>            : Use <file> as master object.\n"
	       " -d -d#               : Increase debug (# is how much)\n"
	       " -t -t#               : Increase trace level\n"
	  );
	exit(0);

      case "showpaths":
	werror("Include path : " + pike_include_path*"\n"
	       "               " + "\n"
	       "Module path  : " + pike_module_path*"\n"
	       "               " + "\n"
	       "Program path : " + pike_program_path*"\n"
	       "               " + "\n"
	       "Master file  : " + (_master_file_name || __FILE__) + "\n");
	exit(0);
	
      case "execute":
	compile_string("#include <simulate.h>\nmixed create(){"+opts[1]+";}")();
	exit(0);

      case "preprocess":
	_static_modules.files()->_stdout->write(cpp(_static_modules.files()->Fd(opts[1],"r")->read(),opts[1]));
	exit(0);
      }
    }

    argv = tmp->get_args(argv,1);
  }

  if(sizeof(argv)==1)
  {
    /* Attempt to resolv Tools.Hilfe.StdinHilfe */
    tmp = resolv("Tools");
    if (!tmp) {
      werror("Couldn't find Tools.\n");
      exit(1);
    }
    tmp = tmp["Hilfe"];
    if (!tmp) {
      werror("Couldn't find Hilfe.\n");
      exit(1);
    }
    tmp->StdinHilfe();
    exit(0);
  } else {
    argv=argv[1..];
  }

  argv[0]=combine_path_with_cwd(argv[0]);

  program tmp;

  mixed err = catch {
    tmp=(program)argv[0];
  };

  if (err) {
    werror(sprintf("Pike: Failed to compile script:\n"
		   "%s\n", stringp(err[0])?err[0]:describe_backtrace(err)));
    exit(1);
  }

  // FIXME: Isn't the following code dead?
  if(!tmp)
  {
    werror("Pike: Couldn't find script to execute\n(%O)\n",argv[0]);
    exit(1);
  }

  object script=tmp();

#if constant(_debug)
  if(debug) _debug(debug);
#endif
  if(!script->main)
  {
    werror("Error: "+argv[0]+" has no main().\n");
    exit(1);
  }

  if(trace) predef::trace(trace);
  i=script->main(sizeof(argv),argv,env);
  if(i >=0) exit(i);
}

mixed inhibit_compile_errors;

void set_inhibit_compile_errors(mixed f)
{
  inhibit_compile_errors=f;
}

string trim_file_name(string s)
{
  if(getenv("LONG_PIKE_ERRORS")) return s;
  if(getenv("SHORT_PIKE_ERRORS")) return BASENAME(s);
  string cwd=getcwd();
  if(s[..sizeof(cwd)-1]==cwd) return s[sizeof(cwd)..];
  return s;
}

/*
 * This function is called whenever a compiling error occurs,
 * Nothing strange about it.
 * Note that previous_object cannot be trusted in ths function, because
 * the compiler calls this function.
 */
void compile_error(string file,int line,string err)
{
  if(!inhibit_compile_errors)
  {
    werror(sprintf("%s:%d:%s\n",trim_file_name(file),line,err));
  }
  else if(objectp(inhibit_compile_errors) ||
	  programp(inhibit_compile_errors) ||
	  functionp(inhibit_compile_errors))
  {
    inhibit_compile_errors(file,line,err);
  }
}

/*
 * This function is called whenever a compiling error occurs,
 * Nothing strange about it.
 * Note that previous_object cannot be trusted in ths function, because
 * the compiler calls this function.
 */
void compile_warning(string file,int line,string err)
{
  if(!inhibit_compile_errors)
  {
    if(want_warnings)
      werror(sprintf("%s:%d:%s\n",trim_file_name(file),line,err));
  }
}


static mixed _charset_mod;
/* This function is called by cpp() when it wants to do
 * character code conversion.
 */
string decode_charset(string data, string charset)
{
  // werror(sprintf("decode_charset(%O, %O)\n", data, charset));

  if (!_charset_mod) {
    mixed mod = resolv("Locale");

    _charset_mod = mod && mod["Charset"];
    if (!_charset_mod) {
      compile_warning("-", 0, "No Locale.Charset module!");
      return 0;
    }
  }

  object decoder;

  catch {
    decoder = _charset_mod->decoder(charset);
  };

  if (!decoder) {
    compile_warning("-", 0, sprintf("Unknown charset %O!", charset));
    return 0;
  }
  return decoder->feed(data)->drain();
}


/* This function is called whenever an #include directive is encountered
 * it receives the argument for #include and should return the file name
 * of the file to include
 * Note that previous_object cannot be trusted in ths function, because
 * the compiler calls this function.
 */
string handle_include(string f,
		      string current_file,
		      int local_include)
{
  string *tmp, path;

  if(local_include)
  {
    tmp=EXPLODE_PATH(current_file);
    tmp[-1]=f;
    path=combine_path_with_cwd(tmp*"/");
  }
  else
  {
    foreach(pike_include_path, path)
      {
	path=combine_path(path,f);
	if(master_file_stat(path))
	  break;
	else
	  path=0;
      }
    
  }

  return path;
}

string read_include(string f)
{
  AUTORELOAD_CHECK_FILE(f)
  object o=_static_modules.files()->Fd();
  if(o->open(f,"r"))
    return o->read();
}

int clipped=0;

// FIXME
string stupid_describe(mixed m, int maxlen)
{
  switch(string typ=sprintf("%t",m))
  {
    case "int":
    case "float":
      return (string)m;
      
    case "string":
      if(sizeof(m) < maxlen)
      {
	string t = sprintf("%O", m);
	if (sizeof(t) < (maxlen + 2)) {
	  return t;
	}
	t = 0;
      }
      clipped++;
      if(maxlen>10)
      {
	return sprintf("%O+[%d]",m[..maxlen-5],sizeof(m)-(maxlen-5));
      }else{
	return "string["+sizeof(m)+"]";
      }
      
    case "array":
      if(!sizeof(m)) return "({})";
      if(maxlen<5)
      {
	clipped++;
	return "array["+sizeof(m)+"]";
      }
      return "({" + stupid_describe_comma_list(m,maxlen-2) +"})";
      
    case "mapping":
      if(!sizeof(m)) return "([])";
      return "mapping["+sizeof(m)+"]";
      
    case "multiset":
      if(!sizeof(m)) return "(<>)";
      return "multiset["+sizeof(m)+"]";
      
    case "function":
      if(string tmp=describe_program(m)) return tmp;
      if(object o=function_object(m))
	return (describe_object(o)||"")+"->"+function_name(m);
      else
	return function_name(m) || "function";
      
    case "program":
      if(string tmp=describe_program(m)) return tmp;
      return typ;

    case "object":
      if(string tmp=describe_object(m)) return tmp;
      return typ;

    default:
      return typ;
  }
}

string stupid_describe_comma_list(array x, int maxlen)
{
  string ret="";

  if(!sizeof(x)) return "";
  if(maxlen<0) return ",,,"+sizeof(x);

  int clip=min(maxlen/2,sizeof(x));
  int len=maxlen;

  while(1)
  {
//    werror("len=%d\n",len);
    array(string) z=allocate(clip);
    array(int) isclipped=allocate(clip);
    for(int e=0;e<clip;e++)
    {
      clipped=0;
      z[e]=stupid_describe(x[e],len);
      isclipped[e]=clipped;
    }

    while(1)
    {
//      werror("clip=%d maxlen=%d\n",clip,maxlen);
      string ret = z[..clip-1]*",";
//      werror("sizeof(ret)=%d z=%O isclipped=%O\n",sizeof(ret),z[..clip-1],isclipped[..clip-1]);
      if(sizeof(ret)<=maxlen+1)
      {
	int tmp=sizeof(x)-clip-1;
//	werror("CLIPPED::::: %O\n",isclipped);
	clipped=`+(0,@isclipped);
	if(tmp>=0)
	{
	  clipped++;
	  ret+=",,,"+tmp;
	}
	return ret;
      }

      int last_newlen=len;
      int newlen;
      int clipsuggest;
      while(1)
      {
	int smallsize=0;
	int num_large=0;
	clipsuggest=0;

	for(int e=0;e<clip;e++)
	  {
//	    werror("sizeof(z[%d])=%d  len=%d\n",e,sizeof(z[e]),len);

	    if(sizeof(z[e])>=last_newlen || isclipped[e])
	      num_large++;
	    else
	      smallsize+=sizeof(z[e]);

	    if(num_large * 15 + smallsize < maxlen) clipsuggest=e+1;
	  }
	
//	werror("num_large=%d  maxlen=%d  smallsize=%d clippsuggest=%d\n",num_large,maxlen,smallsize,clipsuggest);
	newlen=num_large ? (maxlen-smallsize)/num_large : 0;
	
//	werror("newlen=%d\n",newlen);

	if(newlen<8 || newlen >= last_newlen) break;
	last_newlen=newlen;
//	werror("len decreased, retrying.\n");
      }

      if(newlen < 8 && clip)
      {
	clip-= (clip/4) || 1;
	if(clip > clipsuggest) clip=clipsuggest;
//	werror("clip decreased, retrying.\n");
      }else{
	len=newlen;
	break;
      }
    }
  }

  return ret;
}

string describe_object(object o)
{
  string s;
  if(!o) return 0;
  if(s=search(objects,object_program(o)))
  {
    if(sscanf(reverse(s),"%s.%s",string ext,string rest) && ext=="domp")
      return EXPLODE_PATH(reverse(rest))[-1];
    return s;
  }
  if(( s=describe_program(object_program(o)) ))
    return s+"()";
  return 0;
}

string describe_program(program p)
{
  string s;
  if(!p) return 0;
  if(s=search(programs,p))
  {
    if(sscanf(reverse(s),"%s.%s",string ext,string rest) && ext=="domp")
      return EXPLODE_PATH(reverse(rest))[-1];
    return trim_file_name(s);
  }

  if(functionp(p))
    if(mixed tmp=function_object(p))
      if(s=describe_program(object_program(tmp)))
	return s+"."+function_name(p);

  if(s=_static_modules.Builtin()->program_defined(p))
    return EXPLODE_PATH(s)[-1];

  return 0;
}

/* It is possible that this should be a real efun,
 * it is currently used by handle_error to convert a backtrace to a
 * readable message.
 */
string describe_backtrace(mixed trace, void|int linewidth)
{
  int e;
  string ret;

  if(!linewidth)
  {
    linewidth=99999;
    catch 
    {
      linewidth=_static_modules.files()->_stdin->tcgetattr()->columns;
    };
  }

  if((arrayp(trace) && sizeof(trace)==2 && stringp(trace[0])) ||
     (objectp(trace) && trace->is_generic_error))
  {
    if (catch {
      ret = trace[0];
      trace = trace[1];
    }) {
      return "Error indexing backtrace!\n";
    }
  }else{
    ret="";
  }

  if(!arrayp(trace))
  {
    ret+="No backtrace.\n";
  }else{
    for(e = sizeof(trace)-1; e>=0; e--)
    {
      mixed tmp;
      string row;

      if (mixed err=catch {
	tmp = trace[e];
	if(stringp(tmp))
	{
	  row=tmp;
	}
	else if(arrayp(tmp))
	{
	  string pos;
	  if(sizeof(tmp)>=2 && stringp(tmp[0]) && intp(tmp[1]))
	  {
	    pos=trim_file_name(tmp[0])+":"+tmp[1];
	  }else{
	    mixed desc="Unknown program";
	    if(sizeof(tmp)>=3 && functionp(tmp[2]))
	    {
	      catch {
		if(mixed tmp=function_object(tmp[2]))
		  if(tmp=object_program(tmp))
		    if(tmp=describe_program(tmp))
		      desc=tmp;
	      };
	    }
	    pos=desc;
	  }
	  
	  string data;
	  
	  if(sizeof(tmp)>=3)
	  {
	    if(functionp(tmp[2]))
	      data = function_name(tmp[2]);
	    else if (stringp(tmp[2])) {
	      data= tmp[2];
	    } else
	      data ="unknown function";
	    
	    data+="("+
	      stupid_describe_comma_list(tmp[3..], BT_MAX_STRING_LEN)+
	    ")";

	    if(sizeof(pos)+sizeof(data) < linewidth-4)
	    {
	      row=sprintf("%s: %s",pos,data);
	    }else{
	      row=sprintf("%s:\n%s",pos,sprintf("    %*-/s",linewidth-6,data));
	    }
	  }
	}
	else
	{
	  row="Destructed object";
	}
      }) {
	row += sprintf("Error indexing backtrace line %d (%O)!", e, err[1]);
      }
      ret += row + "\n";
    }
  }

  return ret;
}


class Codec
{
  mapping f=all_constants();

  string nameof(mixed x)
    {
      if(mixed tmp=search(f,x))
	return "efun:"+tmp;
      
      switch(sprintf("%t",x))
      {
	case "program":
	  if(mixed tmp=search(programs,x))
	    return tmp;

	  if(mixed tmp=search(values(_static_modules), x))
	    return "_static_modules."+(indices(_static_modules)[tmp]);
	  break;
	  
	case "object":
	  if(mixed tmp=search(objects,x))
	    if(tmp=search(programs,tmp))
	      return tmp;
	  break;
      }
      return ([])[0];
    } 
  
  function functionof(string x)
    {
      if(sscanf(x,"efun:%s",x)) return f[x];
      return 0;
    }
  
  object objectof(string x)
    {
      if(sscanf(x,"efun:%s",x)) return f[x];
      return cast_to_object(x,0);
    }
  
  program programof(string x)
    {
      if(sscanf(x,"efun:%s",x)) return f[x];

      return cast_to_program(x,0);
    }
  
  mixed encode_object(object x)
    {
      error("Cannot encode objects yet.\n");
    }
  
  
  mixed decode_object(object x)
  {
    error("Cannot encode objects yet.\n");
  }
}