pike.git/
lib/
master.pike.in
Branch:
Tag:
Non-build tags
All tags
No tags
1998-03-28
1998-03-28 16:36:56 by Henrik Grubbström (Grubba) <grubba@grubba.org>
ca2b079096b8ccfce86352a4d8d497066638212b (
838
lines) (+
838
/-
0
)
[
Show
|
Annotate
]
Branch:
7.9
Used to support different directories for shared and lib.
Rev: lib/master.pike.in:1.1
1:
+
/* $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 Hübinette\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;
+
}
Newline at end of file added.