Used to support different directories for shared and lib.

Rev: lib/master.pike.in:1.1

.gitattributes

@@ -20,6 +20,7 @@ testfont binary
 /bin/mkpeep.pike foreign_ident
 /bin/test_pike.pike foreign_ident
 /lib/master.pike foreign_ident
+/lib/master.pike.in foreign_ident
 /lib/modules/ADT.pmod/Table.pmod foreign_ident
 /lib/modules/ADT.pmod/queue.pike foreign_ident
 /lib/modules/ADT.pmod/struct.pike foreign_ident

lib/master.pike.in

+/* $Id: master.pike.in,v 1.1 1998/03/28 16:36:56 grubba Exp $
+ *
+ * Master-file for Pike.
+ *
+ * Based on master.pike 1.67.
+ */
+
+int is_absolute_path(string p)
+{
+#ifdef __NT__
+  p=replace(p,"\\","/");
+  if(sscanf(p,"%[a-zA-Z]:",string s) && sizeof(s)==1)
+    return 1;
+#endif
+  return p[0]=='/';
+}
+
+string *explode_path(string p)
+{
+#ifdef __NT__
+  p=replace(p,"\\","/");
+#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 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 _master_file_name;
+string pike_library_path;
+string *pike_include_path=({});
+string *pike_module_path=({});
+string *pike_program_path=({});
+int want_warnings;
+
+program compile_string(string data, void|string name)
+{
+  return compile(cpp(data,name||"-"));
+}
+
+program compile_file(string file)
+{
+  return compile(cpp(_static_modules.files()->file(file,"r")->read(),file));
+}
+
+
+#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;
+  if(ret=programs[fname]) return ret;
+  if( (s=master_file_stat(fname)) 
+      && s[1]>=0 )
+  {
+    switch(ext)
+    {
+    case "":
+    case ".pike":
+      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":
+      ret=load_module(fname);
+#endif /* load_module */
+    }
+    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);
+  werror(describe_backtrace(trace));
+}
+
+object new(mixed prog, mixed ... args)
+{
+  if(stringp(prog))
+    prog=cast_to_program(prog,backtrace()[-2][0]);
+  return prog(@args);
+}
+
+/* Note that create is called before add_precompiled_program
+ */
+void create()
+{
+  add_constant("basename",basename);
+  add_constant("dirname",dirname);
+  add_constant("is_absolute_path",is_absolute_path);
+  add_constant("explode_path",explode_path);
+
+  add_constant("compile_string",compile_string);
+  add_constant("compile_file",compile_file);
+  add_constant("add_include_path",add_include_path);
+  add_constant("remove_include_path",remove_include_path);
+  add_constant("add_module_path",add_module_path);
+  add_constant("remove_module_path",remove_module_path);
+  add_constant("add_program_path",add_program_path);
+  add_constant("remove_program_path",remove_program_path);
+  add_constant("describe_backtrace",describe_backtrace);
+  add_constant("mkmultiset",lambda(mixed *a) { return aggregate_multiset(@a); });
+  add_constant("strlen",sizeof);
+  add_constant("new",new);
+  add_constant("clone",new);
+  add_constant("UNDEFINED",UNDEFINED);
+
+#ifdef GETCWD_CACHE
+  add_constant("cd",cd);
+  add_constant("getcwd",getcwd);
+#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;
+  object tm;
+  mixed module;
+  mapping cache=([]);
+
+  void create(string name, object the_master)
+  {
+    dirname=name;
+    tm=the_master;
+
+    if(module=tm->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=tm->findmodule(index))
+    {
+      if(mixed tmp=o->_module_value) o=tmp;
+      return o;
+    }
+    return (program) index;
+  }
+
+  object|program `[](string index)
+  {
+    mixed ret;
+    if(!zero_type(ret=cache[index]))
+    {
+      if(ret) return ret;
+      return UNDEFINED;
+    }
+    return cache[index]=ind(index);
+  }
+};
+
+static 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",this_object());
+  }
+
+  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 resolv(string identifier, string|void current_file)
+{
+  mixed ret;
+  string *tmp,path;
+
+  if(current_file)
+  {
+    tmp=explode_path(current_file);
+    tmp[-1]=identifier;
+    path=combine_path_with_cwd( tmp*"/");
+    ret=findmodule(path);
+  }
+
+  if(!ret)
+  {
+    foreach(pike_module_path, path)
+      {
+	string file=combine_path(path,identifier);
+	if(ret=findmodule(file)) break;
+      }
+    
+    if(!ret)
+    {
+      string path=combine_path(pike_library_path+"/modules",identifier);
+      ret=findmodule(path);
+    }
+  }
+
+
+  if(ret)
+  {
+    if(mixed tmp=ret->_module_value) ret=tmp;
+    return ret;
+  }
+  return UNDEFINED;
+}
+
+/* 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 *argv, string *env)
+{
+  int i;
+  object script;
+  object tmp;
+  string a,b;
+  mixed *q;
+
+  foreach(env,a) if(sscanf(a,"%s=%s",a,b)) environment[a]=b;
+  add_constant("getenv",getenv);
+  add_constant("putenv",putenv);
+
+  add_constant("write",_static_modules.files()->file("stdout")->write);
+
+  _master_file_name=backtrace()[-1][0];
+  q=explode_path(_master_file_name);
+  pike_library_path = combine_path_with_cwd(q[0..sizeof(q)-2] * "/");
+
+  add_include_path(pike_library_path+"/include");
+  add_module_path(pike_library_path+"/modules");
+
+  a = replace(pike_library_path+"/", "/lib/", "/share/");
+  if (a != pike_library_path+"/") {
+    array st;
+    if ((st = file_stat(a)) && (sizeof(st)) && (st[1] == -2)) {
+      add_include_path(a+"/include");
+      add_module_path(a+"/modules");
+    }
+  }
+
+  add_program_path(getcwd());
+  add_module_path(getcwd());
+
+  _master_file_name=combine_path(getcwd(), _master_file_name);
+
+  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]);
+
+  
+  if(sizeof(argv)>1 && sizeof(argv[1]) && argv[1][0]=='-')
+  {
+    tmp=resolv("Getopt");
+    
+    q=tmp->find_all_options(argv,({
+      ({"version",tmp->NO_ARG,({"-v","--version"})}),
+	({"help",tmp->NO_ARG,({"-h","--help"})}),
+	  ({"execute",tmp->HAS_ARG,({"-e","--execute"})}),
+	    ({"modpath",tmp->HAS_ARG,({"-M","--module-path"})}),
+	      ({"ipath",tmp->HAS_ARG,({"-I","--include-path"})}),
+		({"ppath",tmp->HAS_ARG,({"-P","--program-path"})}),
+		  ({"warnings",tmp->NO_ARG,({"-w","--warnings"})}),
+		    ({"ignore",tmp->HAS_ARG,"-ms"}),
+		      ({"ignore",tmp->MAY_HAVE_ARG,"-Ddatpl",0,1})
+			}), 1);
+    
+    /* Parse -M and -I backwards */
+    for(i=sizeof(q)-1;i>=0;i--)
+    {
+      switch(q[i][0])
+      {
+      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;
+      }
+    }
+    
+    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"
+	       " -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 "execute":
+	compile_string("#include <simulate.h>\nmixed create(){"+opts[1]+";}")();
+	exit(0);
+      }
+    }
+
+    argv=tmp->get_args(argv,1);
+  }
+
+  if(sizeof(argv)==1)
+  {
+    argv=explode_path(argv[0]);
+    argv[-1]="hilfe";
+    argv=({ argv*"/" });
+    if(!master_file_stat(argv[0]))
+    {
+      if(master_file_stat("exec_prefix/bin/hilfe"))
+	argv[0]="exec_prefix/bin/hilfe";
+      else if(master_file_stat("../bin/hilfe"))
+	argv[0]="../bin/hilfe";
+      else
+      {
+	werror("Couldn't find hilfe.\n");
+	exit(1);
+      }
+    }
+  }else{
+    argv=argv[1..];
+  }
+
+  program tmp=(program)argv[0];
+
+  if(!tmp)
+  {
+    werror("Pike: Couldn't find script to execute.\n");
+    exit(1);
+  }
+
+  object script=tmp();
+
+  if(!script->main)
+  {
+    werror("Error: "+argv[0]+" has no main().\n");
+    exit(1);
+  }
+
+  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("SHORT_PIKE_ERRORS")) return basename(s);
+  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(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));
+  }
+}
+
+
+/* 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*"/");
+    if(!master_file_stat(path)) return 0;
+  }
+  else
+  {
+    foreach(pike_include_path, path)
+      {
+	path=combine_path(path,f);
+	if(master_file_stat(path))
+	  break;
+	else
+	  path=0;
+      }
+    
+    if(!path)
+    {
+      path=combine_path(pike_library_path+"/include",f);
+      if(!master_file_stat(path)) path=0;
+    }
+  }
+
+  if(path)
+  {
+    /* Handle preload */
+
+    if(path[-1]=='h' && path[-2]=='.' &&
+       master_file_stat(path[0..sizeof(path)-2]+"pre.pike"))
+    {
+      cast_to_object(path[0..sizeof(path)-2]+"pre.pike","/");
+    }
+  }
+
+  return path;
+}
+
+string read_include(string f)
+{
+  return _static_modules->files()->file(f,"r")->read();
+}
+
+// FIXME
+string stupid_describe(mixed m)
+{
+  switch(string typ=sprintf("%t",m))
+  {
+  case "int":
+  case "float":
+    return (string)m;
+
+  case "string":
+    if(sizeof(m) < 60 && sscanf(m,"%*[-a-zAZ0-9.~`!@#$%^&*()_]%n",int i) && i==sizeof(m))
+    {
+      return "\""+m+"\"";
+    }
+
+  case "array":
+  case "mapping":
+  case "multiset":
+    return typ+"["+sizeof(m)+"]";
+
+  default:
+    return sprintf("%t",m);
+  }
+}
+
+/* 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)
+{
+  int e;
+  string ret;
+
+  if(arrayp(trace) && sizeof(trace)==2 && stringp(trace[0]))
+  {
+    ret=trace[0];
+    trace=trace[1];
+  }else{
+    ret="";
+  }
+
+  if(!arrayp(trace))
+  {
+    ret+="No backtrace.\n";
+  }else{
+    for(e=sizeof(trace)-1;e>=0;e--)
+    {
+      mixed tmp;
+      string row;
+
+      tmp=trace[e];
+      if(stringp(tmp))
+      {
+	row=tmp;
+      }
+      else if(arrayp(tmp))
+      {
+	row="";
+	if(sizeof(tmp)>=3)
+	{
+	  if(functionp(tmp[2]))
+	    row=function_name(tmp[2]);
+	  else
+	    row="unknown function";
+	    
+	  row+="(";
+	  for(int e=3;e<sizeof(tmp);e++)
+	  {
+	    row+=stupid_describe(tmp[e])+",";
+	  }
+
+	  if(sizeof(tmp)>3)
+	    row=row[..sizeof(row)-2];
+	  row+=") in ";
+	}
+
+	if(sizeof(tmp)>=2 && stringp(tmp[0]) && intp(tmp[1]))
+	{
+	  row+="line "+tmp[1]+" in "+trim_file_name(tmp[0]);
+	}else{
+	  row+="Unknown program";
+	}
+      }
+      else
+      {
+	row="Destructed object";
+      }
+      ret+=row+"\n";
+    }
+  }
+
+  return ret;
+}