// -*- Pike -*-
//
// Master Control Program for Pike.
//
// This file is part of Pike. For copyright information see COPYRIGHT.
// Pike is distributed under GPL, LGPL and MPL. See the file COPYING
// for more information.
//
#pike __REAL_VERSION__
//#pragma strict_types
//! @appears predef::MasterObject
//!
//! Master control program for Pike.
//!
//! @seealso
//! @[predef::master()], @[predef::replace_master()]
// --- Some configurable parameters
#define PIKE_AUTORELOAD
#define GETCWD_CACHE
//#define FILE_STAT_CACHE
// This define is searched and replaced by bin/install.pike.
#undef PIKE_MODULE_RELOC
#ifndef PIKE_WARNINGS
#define PIKE_WARNINGS 1
#endif /* PIKE_WARNINGS */
// --- Global constants and variables
// 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 200
#endif /* !defined(BT_MAX_STRING_LEN) || (BT_MAX_STRING_LEN <= 0) */
constant bt_max_string_len = BT_MAX_STRING_LEN;
//! @decl constant bt_max_string_len = 200
//! This constant contains the maximum length of a function entry in a
//! backtrace. Defaults to 200 if no BT_MAX_STRING_LEN define has been
//! given.
// Enables the out of date warning in low_findprog().
#ifndef OUT_OF_DATE_WARNING
#define OUT_OF_DATE_WARNING 1
#endif /* OUT_OF_DATE_WARNING */
constant out_of_date_warning = OUT_OF_DATE_WARNING;
// FIXME: PATH_SEPARATOR and UPDIR should probably be exported,
// or at least some functions that use them should be.
// cf Tools.Shoot.runpike.
// /grubba 2004-04-11
#if defined(__NT__) || defined(__amigaos__) || defined(__OS2__)
#define PATH_SEPARATOR ";"
#else
#define PATH_SEPARATOR ":"
#endif
#ifdef __amigaos__
#define UPDIR "/"
#else
#define UPDIR "../"
#endif
//! @decl constant out_of_date_warning = 1
//! Should Pike complain about out of date compiled files.
//! 1 means yes and 0 means no. Controlled by the OUT_OF_DATE_WARNING
//! define.
//! If not zero compilation warnings will be written out on stderr.
int want_warnings = PIKE_WARNINGS;
//!
int compat_major=-1;
//!
int compat_minor=-1;
//!
int show_if_constant_errors = 0;
int is_pike_master = 0;
// This integer variable should exist in any object that aspires to be
// the master. It gets set to 1 when the master is installed, and is
// therefore set in any object that is or has been the master. That
// makes the Encoder class encode references to the master and all
// ex-masters as references to the current master object.
// --- Functions begin here.
// Have to access some stuff without going through the resolver.
private object(_static_modules.Builtin) Builtin = _static_modules.Builtin();
private constant Files = _static_modules._Stdio;
#define Stat Files.Stat
#define capitalize(X) (upper_case((X)[..0])+(X)[1..])
#define trim_all_whites(X) (Builtin.string_trim_all_whites (X))
private function write = Files()->_stdout->write;
private function werror = Files()->_stderr->write;
// Tell Pike.count_memory this is global.
constant pike_cycle_depth = 0;
//#define RECUR_COMPILE_DEBUG
// More brief than RESOLV_DEBUG. Usually enough to find those pesky
// "Recursive module dependency" bugs. :P
#if defined (RESOLV_DEBUG) || defined (RECUR_COMPILE_DEBUG)
#if constant (thread_local)
protected object _msg_depth = thread_local();
// NOTE: May be used before __INIT has completed.
#define GET_MSG_DEPTH (_msg_depth && _msg_depth->get())
#define INC_MSG_DEPTH() (_msg_depth && _msg_depth->set (_msg_depth->get() + 1))
#define DEC_MSG_DEPTH() (_msg_depth && _msg_depth->set (_msg_depth->get() - 1))
#else
protected int _msg_depth;
#define GET_MSG_DEPTH _msg_depth
#define INC_MSG_DEPTH() (++_msg_depth)
#define DEC_MSG_DEPTH() (--_msg_depth)
#endif
#endif
#ifdef RESOLV_DEBUG
#define GET_RESOLV_MSG_DEPTH GET_MSG_DEPTH
#define INC_RESOLV_MSG_DEPTH() INC_MSG_DEPTH()
#define DEC_RESOLV_MSG_DEPTH() DEC_MSG_DEPTH()
void resolv_debug (sprintf_format fmt, sprintf_args... args)
{
string pad = " " * GET_RESOLV_MSG_DEPTH;
if (sizeof (args)) fmt = sprintf (fmt, @args);
if (fmt[-1] == '\n')
fmt = pad + replace (fmt[..<1], "\n", "\n" + pad) + "\n";
else
fmt = pad + replace (fmt, "\n", "\n" + pad);
if (!werror) werror = Files()->_stderr->write;
werror (fmt);
}
#else // !RESOLV_DEBUG
#define INC_RESOLV_MSG_DEPTH() 0
#define DEC_RESOLV_MSG_DEPTH() 0
#define resolv_debug(X...) do {} while (0)
#endif // !RESOLV_DEBUG
constant no_value = (<>);
constant NoValue = typeof (no_value);
// Some API compatibility stuff.
//! Pike 7.6 master compatibility interface.
//!
//! Most of the interface is implemented via mixin,
//! or overloading by more recent masters.
//!
//! This interface is used for compatibility with
//! Pike 7.6.
//!
//! @deprecated predef::MasterObject
//!
//! @seealso
//! @[get_compat_master()], @[master()], @[predef::MasterObject]
protected class Pike_7_6_master
{
extern array(string) pike_include_path;
extern array(string) pike_module_path;
extern array(string) pike_program_path;
#ifdef GETCWD_CACHE
extern string current_path;
int cd(string s);
string getcwd();
#endif
string combine_path_with_cwd(string path);
#ifdef FILE_STAT_CACHE
extern int invalidate_time;
extern mapping(string:multiset(string)) dir_cache;
#endif
//! @decl mapping(string:array(string)) environment
//!
//! Mapping containing the environment variables.
//!
//! The mapping currently has the following structure:
//! @mapping
//! @member array(string) index
//! Note that the index is @[lower_case()]'d on NT.
//! @array
//! @elem string varname
//! Variable name with case intact.
//! @elem string value
//! Variable value.
//! @endarray
//! @endmapping
//!
//! @note
//! This mapping should not be accessed directly; use @[getenv()]
//! and @[putenv()] instead. This mapping is not publicly
//! accessible in pikes newer than 7.6.
//!
//! @note
//! This mapping is not compatible with @[Process.create_process()];
//! use the mapping returned from calling @[getenv()] without arguments
//! instead.
//!
//! @bugs
//! This mapping is not the real environment; it is just a copy of
//! the environment made at startup. Pike does attempt to keep
//! track of changes in the mapping and to reflect them in the
//! real environment, but avoid accessing this mapping if at all
//! possible.
string|mapping(string:string) getenv(string|void s);
void putenv(string|void varname, string|void value);
// compat_environment is the mapping returned by `environment
// (if any).
// compat_environment_copy is used to keep track of any changes
// performed destructively on the compat_environment mapping.
// Both should be zero if not in use.
// Removed in Pike 7.8.
protected mapping(string:array(string)) compat_environment;
protected mapping(string:array(string)) compat_environment_copy;
#pragma no_deprecation_warnings
local __deprecated__(mapping(string:array(string))) `environment()
{
if (compat_environment) return compat_environment;
compat_environment_copy = ([]);
#ifdef __NT__
// Can't use the cached environment returned by getenv(), since
// variable names have been lowercased there.
foreach((array(array(string)))Builtin._getenv(), array(string) pair) {
compat_environment_copy[lower_case(pair[0])] = pair;
}
#else
foreach((array(array(string)))getenv(), array(string) pair) {
compat_environment_copy[pair[0]] = pair;
}
#endif
return compat_environment = copy_value(compat_environment_copy);
}
local void `environment=(__deprecated__(mapping(string:array(string)))
new_env)
{
compat_environment = new_env;
if (!new_env)
compat_environment_copy = 0;
else if (!compat_environment_copy)
compat_environment_copy = ([]);
}
#pragma deprecation_warnings
void add_include_path(string tmp);
void remove_include_path(string tmp);
void add_module_path(string tmp);
void remove_module_path(string tmp);
void add_program_path(string tmp);
void remove_program_path(string tmp);
mapping(string:program|NoValue) programs;
extern mapping(program:object) objects;
object cast_to_object(string oname, string current_file);
class dirnode {};
extern string _master_file_name;
void _main(array(string) orig_argv, array(string) env);
extern mixed inhibit_compile_errors;
void set_inhibit_compile_errors(mixed f);
string trim_file_name(string s);
void compile_error(string file,int line,string err);
string handle_include(string f, string current_file, int local_include);
int is_absolute_path(string p);
array(string) explode_path(string p);
string dirname(string x);
string basename(string x);
object low_cast_to_object(string oname, string current_file);
extern int want_warnings;
program compile_string(string data, void|string name);
program compile_file(string file);
constant master_efuns = ({});
class joinnode {};
extern mapping(string:mixed) fc;
extern string _pike_file_name;
void compile_warning(string file,int line,string err);
string read_include(string f);
class Codec {};
constant bt_max_string_len = 1;
constant out_of_date_warning = 1;
#ifdef PIKE_FAKEROOT
extern object o;
string fakeroot(string s);
#endif
#ifdef PIKE_AUTORELOAD
extern int autoreload_on;
extern int newest;
extern mapping(string:int) load_time;
#endif
string master_read_file();
string normalize_path(string X);
array(string) query_precompiled_names(string fname);
program cast_to_program(string pname, string current_file,
object|void handler);
void handle_error(array(mixed)|object trace);
program handle_inherit(string pname, string current_file, object|void handler);
mixed handle_import(string what, string|void current_file, object|void handler);
mixed resolv_base(string identifier, string|void current_file);
mixed get_inhibit_compile_errors();
string decode_charset(string data, string charset);
string describe_object(object o);
string describe_backtrace(array(mixed) trace, void|int linewidth);
string describe_error(mixed trace);
// ---
#ifdef PIKE_MODULE_RELOC
string relocate_module(string s);
string unrelocate_module(string s);
#endif
extern int compat_major;
extern int compat_minor;
Stat master_file_stat(string x);
object low_cast_to_object(string oname, string current_file,
object|void current_handler);
object findmodule(string fullname, object|void handler);
extern multiset no_resolv;
extern string ver;
mapping get_default_module();
void runtime_warning(string where, string what, mixed ... args);
protected int clipped;
protected int canclip;
protected string stupid_describe(mixed m, int maxlen);
protected string stupid_describe_comma_list(array x, int maxlen);
class Describer {};
string describe_function(function f);
class CompatResolver {};
int(0..1) asyncp();
class Version {};
extern object currentversion;
extern mapping(object:object) compat_handler_cache;
object get_compilation_handler(int major, int minor);
// ---
#ifdef RESOLV_DEBUG
void resolv_debug (sprintf_format fmt, sprintf_args... args);
#endif
void error(sprintf_format f, sprintf_args ... args);
constant no_value = (<>);
constant NoValue = typeof (no_value);
string programs_reverse_lookup (program prog);
program objects_reverse_lookup (object obj);
string fc_reverse_lookup (object obj);
void unregister(program p);
program low_cast_to_program(string pname,
string current_file,
object|void handler,
void|int mkobj);
extern string include_prefix;
extern mapping(string:string) predefines;
void add_predefine (string name, string value);
void remove_predefine (string name);
mapping get_predefines();
#if constant(thread_create)
object backend_thread();
#endif
function(string:string) set_trim_file_name_callback(function(string:string) s);
int compile_exception (array|object trace);
string program_path_to_name ( string path,
void|string module_prefix,
void|string module_suffix,
void|string object_suffix );
string describe_module(object|program mod, array(object)|void ret_obj);
string describe_program(program|function p);
class Encoder {};
class Decoder {};
extern mapping(string:Codec) codecs;
Codec get_codec(string|void fname, int|void mkobj);
// The following come from the inherit of Codec. */
// Codec::Encoder:
extern mixed encoded;
string|array nameof (mixed what, void|array(object) module_object);
mixed encode_object(object x);
// Codec::Decoder:
extern string fname;
extern int mkobj;
object __register_new_program(program p);
object objectof (string|array what);
function functionof (string|array what);
program programof (string|array what);
void decode_object(object o, mixed data);
string _sprintf(int t);
// ---
extern int show_if_constant_errors;
extern mapping(string:string) initial_predefines;
extern joinnode root_module;
extern mapping(object:joinnode) handler_root_modules;
extern array(string) system_module_path;
extern CompatResolver fallback_resolver;
joinnode get_root_module(object|void current_handler);
local protected object Pike_7_6_compat_handler;
local mixed resolv_or_error(string identifier, string|void current_file,
void|object current_handler)
{
if (!Pike_7_6_compat_handler) {
Pike_7_6_compat_handler = global::get_compilation_handler(7, 6);
}
return Pike_7_6_compat_handler->resolv_or_error(identifier, current_file,
current_handler);
}
local mixed resolv(string identifier, string|void current_file)
{
if (!Pike_7_6_compat_handler) {
Pike_7_6_compat_handler = global::get_compilation_handler(7, 6);
}
return Pike_7_6_compat_handler->resolv(identifier, current_file);
}
array get_backtrace (object|array err);
object get_compat_master(int major, int minor)
{
// 0.0 .. 7.6
if ((major < 7) || ((major == 7) && (minor < 7)))
return this::this;
return get_compat_master(major, minor);
}
/* No missing symbols. */
}
//! Pike 7.8 master compatibility interface.
//!
//! Most of the interface is implemented via mixin,
//! or overloading by more recent masters.
//!
//! This interface is used for compatibility with
//! Pike 7.7 and 7.8.
//!
//! @deprecated predef::MasterObject
//!
//! @seealso
//! @[get_compat_master()], @[master()], @[predef::MasterObject]
protected class Pike_7_8_master
{
inherit Pike_7_6_master;
local protected object Pike_7_8_compat_handler;
local mixed resolv_or_error(string identifier, string|void current_file,
void|object current_handler)
{
if (!Pike_7_8_compat_handler) {
Pike_7_8_compat_handler = global::get_compilation_handler(7, 8);
}
return Pike_7_8_compat_handler->resolv_or_error(identifier, current_file,
current_handler);
}
local mixed resolv(string identifier, string|void current_file)
{
if (!Pike_7_8_compat_handler) {
Pike_7_8_compat_handler = global::get_compilation_handler(7, 8);
}
return Pike_7_8_compat_handler->resolv(identifier, current_file);
}
object get_compat_master(int major, int minor)
{
if ((major < 7) || ((major == 7) && (minor < 7)))
return Pike_7_6_master::get_compat_master(major, minor);
// 7.5 & 7.6
if ((major == 7) && (minor < 9))
return this::this;
return get_compat_master(major, minor);
}
}
//! Namespaces for compat masters.
//!
//! This inherit is used to provide compatibility namespaces
//! for @[get_compat_master()].
//!
//! @seealso
//! @[get_compat_master()]
protected inherit Pike_7_8_master;
//! @appears error
//! Throws an error. A more readable version of the code
//! @expr{throw( ({ sprintf(f, @@args), backtrace() }) )@}.
void error(sprintf_format f, sprintf_args ... args) {
if (sizeof(args)) f = sprintf(f, @args);
throw( ({ f, backtrace()[..<1] }) );
}
// FIXME: Should the pikeroot-things be private?
#ifdef PIKE_FAKEROOT
object o;
string fakeroot(string s)
{
string tmp1=combine_path_with_cwd(s);
#ifdef PIKE_FAKEROOT_OMIT
foreach(PIKE_FAKEROOT_OMIT/PATH_SEPARATOR, string x)
if(glob(x,tmp1))
return s;
#endif
return PIKE_FAKEROOT+tmp1;
}
#else
#define fakeroot(X) X
#endif // PIKE_FAKEROOT
#ifdef PIKE_MODULE_RELOC
string relocate_module(string s)
{
if(s == "/${PIKE_MODULE_PATH}" || has_prefix (s, "/${PIKE_MODULE_PATH}/")) {
string tmp = s[21..];
foreach(pike_module_path, string path) {
string s2 = fakeroot(sizeof(tmp)? combine_path(path, tmp) : path);
if(master_file_stat(s2))
return s2;
}
}
return fakeroot(s);
}
string unrelocate_module(string s)
{
if(s == "/${PIKE_MODULE_PATH}" || has_prefix (s, "/${PIKE_MODULE_PATH}/"))
return s;
foreach(pike_module_path, string path)
if(s == path)
return "/${PIKE_MODULE_PATH}";
else {
path = combine_path(path, "");
if(has_prefix (s, path))
return "/${PIKE_MODULE_PATH}/"+s[sizeof(path)..];
}
/* This is necessary to find compat modules... */
foreach(pike_module_path, string path) {
path = combine_path(path, UPDIR, "");
if(has_prefix (s, path))
return "/${PIKE_MODULE_PATH}/"+UPDIR+s[sizeof(path)..];
}
return s;
}
#ifdef fakeroot
#undef fakeroot
#endif
#define fakeroot relocate_module
#endif // PIKE_MODULE_RELOC
//! @appears is_absolute_path
//! Check if a path @[p] is fully qualified (ie not relative).
//!
//! @returns
//! Returns 1 if the path is absolute, 0 otherwise.
int is_absolute_path(string p)
{
#ifdef __amigaos__
#define IS_ABSOLUTE_PATH(X) (search((X),":")>0)
return IS_ABSOLUTE_PATH(p);
#else
#if defined(__NT__) || defined(__OS2__)
p=replace(p,"\\","/");
if(sscanf(p,"%[a-zA-Z]:%*c",string s)==2 && sizeof(s)==1)
return 1;
#define IS_ABSOLUTE_PATH is_absolute_path
#else
#define IS_ABSOLUTE_PATH(X) has_prefix((X),"/")
#endif
return has_prefix(p,"/");
#endif
}
#if defined(__NT__) || defined(__OS2__)
#define EXPLODE_PATH(X) (replace((X),"\\","/")/"/")
#else
#define EXPLODE_PATH(X) ((X)/"/")
#endif
//! @appears explode_path
//! Split a path @[p] into its components.
//!
//! This function divides a path into its components. This might seem like
//! it could be done by dividing the string on "/", but that will
//! not work on some operating systems. To turn the components back into
//! a path again, use @[combine_path()].
//!
array(string) explode_path(string p)
{
#ifdef __amigaos__
int colon = search(reverse(p), ":");
if(colon >= 0)
return ({ p[..
//! ExpressionValue
//! dirname("/a/b")"/a"
//! dirname("/a/")"/a"
//! dirname("/a")"/"
//! dirname("/")"/"
//! dirname("")""
//! @}
//!
//! @seealso
//! @[basename()], @[explode_path()]
string dirname(string x)
{
if(x=="") return "";
#ifdef __amigaos__
array(string) tmp=x/":";
array(string) tmp2=tmp[-1]/"/";
tmp[-1]=tmp2[..<1]*"/";
if(sizeof(tmp2) >= 2 && tmp2[-2]=="") tmp[-1]+="/";
return tmp*":";
#else
array(string) tmp=EXPLODE_PATH(x);
if(x[0]=='/' && sizeof(tmp)<3) return "/";
return tmp[..<1]*"/";
#endif
}
//! @appears basename
//! Returns the last segment of a path.
//!
//! @seealso
//! @[dirname()], @[explode_path()]
string basename(string x)
{
#ifdef __amigaos__
return ((x/":")[-1]/"/")[-1];
#define BASENAME(X) ((((X)/":")[-1]/"/")[-1])
#else
array(string) tmp=EXPLODE_PATH(x);
return tmp[-1];
#define BASENAME(X) (EXPLODE_PATH(X)[-1])
#endif
}
#ifdef PIKE_AUTORELOAD
int autoreload_on;
int newest;
#define AUTORELOAD_BEGIN() \
int ___newest=newest; \
newest=0
#define AUTORELOAD_CHECK_FILE(X) do { \
if(autoreload_on) \
if(Stat s=master_file_stat(X)) \
if(s->mtime>newest) newest=[int]s->mtime; \
} while(0)
#define AUTORELOAD_CHECK_PRECOMPILED_FILE(X) do { \
if(autoreload_on) { \
int mtime = get_precompiled_mtime (X); \
if (mtime >= 0 && mtime > newest) \
if(s->mtime>newest) newest=[int]s->mtime; \
} \
} while(0)
#define AUTORELOAD_FINISH(VAR, CACHE, FILE) \
if(autoreload_on) { \
mixed val = CACHE[FILE]; \
if(!undefinedp (val) && val != no_value && \
newest <= load_time[FILE]) { \
VAR = val; \
} \
} \
load_time[FILE] = newest; \
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 // PIKE_AUTORELOAD
//! @appears compile_string
//! Compile the Pike code in the string @[source] into a program.
//! If @[filename] is not specified, it will default to @expr{"-"@}.
//!
//! Functionally equal to @expr{@[compile](@[cpp](@[source], @[filename]))@}.
//!
//! @seealso
//! @[compile()], @[cpp()], @[compile_file()]
//!
program compile_string(string source, void|string filename,
object|void handler,
void|program p,
void|object o,
void|int _show_if_constant_errors)
{
#ifdef RECUR_COMPILE_DEBUG
werror ("%*s>>> compile_string %O\n", GET_MSG_DEPTH, "", filename);
INC_MSG_DEPTH();
#endif
string code = cpp(source, filename||"-", 1, handler,
compat_major, compat_minor,
(undefinedp(_show_if_constant_errors)?
show_if_constant_errors:
_show_if_constant_errors));
program ret;
if(code)
ret = compile(code,
handler,
compat_major,
compat_minor,
p,
o);
if (source_cache)
source_cache[ret] = source;
#ifdef RECUR_COMPILE_DEBUG
DEC_MSG_DEPTH();
werror ("%*s<<< compile_string %O\n", GET_MSG_DEPTH, "", filename);
#endif
return ret;
}
//!
string master_read_file(string file)
{
object o=Files()->Fd();
if( ([function(string, string : int)]o->open)(fakeroot(file),"r") )
return ([function(void : string)]o->read)();
return 0;
}
#ifdef GETCWD_CACHE
protected string current_path;
int cd(string s)
{
current_path=0;
return predef::cd(s);
}
string getcwd()
{
return current_path || (current_path=predef::getcwd());
}
#endif // GETCWD_CACHE
string combine_path_with_cwd(string ... paths)
{
return combine_path(IS_ABSOLUTE_PATH(paths[0])?"":getcwd(),@paths);
}
#ifdef FILE_STAT_CACHE
#define FILE_STAT_CACHE_TIME 20
int invalidate_time;
mapping(string:multiset(string)) dir_cache = ([]);
array(string) master_get_dir(string|void x)
{
return get_dir(x);
}
Stat master_file_stat(string x)
{
string dir = combine_path_with_cwd(x);
string file = BASENAME(dir);
dir = dirname(dir);
if(time() > invalidate_time)
{
dir_cache = ([]);
invalidate_time = time()+FILE_STAT_CACHE_TIME;
}
multiset(string) d = dir_cache[dir];
if( undefinedp(d) )
{
array(string) tmp = master_get_dir(dir);
if(tmp)
{
#ifdef __NT__
tmp = map(tmp, lower_case);
#endif
d = dir_cache[dir] = (multiset)tmp;
}
else
dir_cache[dir]=0;
}
#ifdef __NT__
file = lower_case(file);
#endif
if(d && !d[file]) return 0;
return predef::file_stat(x);
}
#else
constant master_file_stat = predef::file_stat;
constant master_get_dir = predef::get_dir;
#endif // FILE_STAT_CACHE
protected mapping(string:string) environment;
#ifdef __NT__
protected void set_lc_env (mapping(string:string) env)
{
environment = ([]);
foreach (env; string var; string val)
environment[lower_case (var)] = val;
}
#endif
//! @decl mapping(string:string) getenv (void|int force_update)
//!
//! Queries the environment variables.
//!
//! @param force_update
//! A cached copy of the real environment is kept to make this
//! function quicker. If the optional flag @[force_update] is nonzero
//! then the real environment is queried and the cache is updated from
//! it. That can be necessary if the environment changes through other
//! means than @[putenv], typically from a C-level library.
//!
//! @returns
//! Returns the whole environment as a mapping. Destructive
//! operations on the mapping will not affect the internal
//! environment representation.
//!
//! Variable names and values cannot be wide strings nor contain
//! @expr{'\0'@} characters. Variable names also cannot contain
//! @expr{'='@} characters.
//!
//! @note
//! On NT the environment variable name is case insensitive.
//!
//! @seealso
//! @[putenv()]
mapping(string:string) getenv (void|int force_update)
{
mapping(string:string) res;
if (force_update) {
res = Builtin._getenv();
#ifdef __NT__
set_lc_env (res);
#else
environment = res + ([]);
#endif
// Kill the compat environment if forced.
compat_environment = compat_environment_copy = 0;
}
else {
if (compat_environment &&
!equal(compat_environment, compat_environment_copy)) {
foreach(compat_environment; string varname; array(string) pair) {
if (!equal(pair, compat_environment_copy[varname])) {
putenv(pair[0], pair[1]);
}
}
foreach(compat_environment_copy; string varname; array(string) pair) {
if (!compat_environment[varname]) {
putenv(pair[0]);
}
}
}
#ifdef __NT__
// Can't use the cached environment since variable names have been
// lowercased there.
res = Builtin._getenv();
if (!environment) set_lc_env (res);
#else
if (!environment) environment = Builtin._getenv();
res = environment + ([]);
#endif
}
return res;
}
//! @decl string getenv (string varname, void|int force_update)
//!
//! Query the value of a specific environment variable.
//!
//! @param varname
//! Environment variable to query.
//!
//! @param force_update
//! A cached copy of the real environment is kept to make this
//! function quicker. If the optional flag @[force_update] is nonzero
//! then the real environment is queried and the cache is updated from
//! it. That can be necessary if the environment changes through other
//! means than @[putenv], typically from a C-level library.
//!
//! @returns
//! Returns the value of the environment variable @[varname]
//! if it exists, and @expr{0@} (zero) otherwise.
//!
//! Variable names and values cannot be wide strings nor contain
//! @expr{'\0'@} characters. Variable names also cannot contain
//! @expr{'='@} characters.
//!
//! @note
//! On NT the environment variable name is case insensitive.
//!
//! @seealso
//! @[putenv()]
variant string getenv (string varname, void|int force_update)
{
if (!environment || force_update) {
#ifdef __NT__
set_lc_env (Builtin._getenv());
#else
environment = Builtin._getenv();
#endif
// Kill the compat environment if forced.
compat_environment = compat_environment_copy = 0;
}
#ifdef __NT__
varname = lower_case(varname);
#endif
if (compat_environment) {
array(string) res;
if (!equal(res = compat_environment[varname],
compat_environment_copy[varname])) {
// Something has messed with the compat environment mapping.
putenv(varname, res[?1]);
}
}
return environment[varname];
}
void putenv (string varname, void|string value)
//! Sets the environment variable @[varname] to @[value].
//!
//! If @[value] is omitted or zero, the environment variable
//! @[varname] is removed.
//!
//! @[varname] and @[value] cannot be wide strings nor contain
//! @expr{'\0'@} characters. @[varname] also cannot contain
//! @expr{'='@} characters.
//!
//! @note
//! On NT the environment variable name is case insensitive.
//!
//! @seealso
//! @[getenv()]
//!
{
Builtin._putenv (varname, value);
if (compat_environment) {
string lvarname = varname;
#ifdef __NT__
lvarname = lower_case(varname);
#endif
if (value) {
compat_environment[lvarname] =
(compat_environment_copy[lvarname] = ({ varname, value })) + ({});
} else {
m_delete(compat_environment, lvarname);
m_delete(compat_environment_copy, lvarname);
}
}
if (environment) {
#ifdef __NT__
varname = lower_case (varname);
#endif
if (value) environment[varname] = value;
else m_delete (environment, varname);
}
}
//! @appears compile_file
//! Compile the Pike code contained in the file @[filename] into a program.
//!
//! This function will compile the file @[filename] to a Pike program that can
//! later be instantiated. It is the same as doing
//! @expr{@[compile_string](@[Stdio.read_file](@[filename]), @[filename])@}.
//!
//! @seealso
//! @[compile()], @[compile_string()], @[cpp()]
//!
program compile_file(string filename,
object|void handler,
void|program p,
void|object o)
{
AUTORELOAD_CHECK_FILE(filename);
string code = cpp(master_read_file(filename),
filename,
1,
handler,
compat_major,
compat_minor);
if (!code) {
error("Required feature missing.\n");
}
return compile(code,
handler,
compat_major,
compat_minor,
p,
o);
}
//! @appears normalize_path
//! Replaces "\" with "/" if runing on MS Windows. It is
//! adviced to use @[System.normalize_path] instead.
string normalize_path( string path )
{
#ifndef __NT__
return path;
#else
return replace(path,"\\","/");
#endif
}
//! Mapping containing the cache of currently compiled files.
//!
//! This mapping currently has the following structure:
//! @mapping
//! @member program filename
//! @endmapping
//! The filename path separator is / on both NT and UNIX.
//!
//! @note
//! Special cases: The current master program is available under the
//! name @expr{"/master"@}, and the program containing the @[main]
//! function under @expr{"/main"@}.
mapping(string:program|NoValue) programs=(["/master":this_program]);
mapping(program:object) documentation = ([]);
mapping(program:string) source_cache;
mapping (program:object|NoValue) objects=([
this_program : this,
object_program(_static_modules): _static_modules,
]);
mapping(string:object|NoValue) fc=([]);
// Note: It's assumed that the mappings above never decrease in size
// unless the reverse mappings above also are updated. no_value should
// otherwise be used for entries that should be considered removed.
// The reverse mapping for objects isn't only for speed; search()
// doesn't work reliably there since it calls `==.
protected mapping(program:string) rev_programs = ([]);
protected mapping(object:program) rev_objects = ([]);
protected mapping(mixed:string) rev_fc = ([]);
string programs_reverse_lookup (program prog)
//! Returns the path for @[prog] in @[programs], if it got any.
{
// When running with trace, this function can get called
// before __INIT has completed.
// NB: We need to be reasonably thread safe, as the compiler
// may be running in another thread.
if (!rev_programs) return UNDEFINED;
if (sizeof (rev_programs) < sizeof (programs)) {
foreach (programs; string path; program|NoValue prog)
if (prog == no_value)
m_delete (programs, path);
else
rev_programs[prog] = path;
}
return rev_programs[prog];
}
program objects_reverse_lookup (object obj)
//! Returns the program for @[obj], if known to the master.
{
// NB: We need to be reasonably thread safe, as the compiler
// may be running in another thread.
if (sizeof (rev_objects) < sizeof (objects)) {
foreach (objects; program prog; object|NoValue obj)
if (obj == no_value)
m_delete (rev_objects, obj);
else
rev_objects[obj] = prog;
}
return rev_objects[obj];
}
string fc_reverse_lookup (object obj)
//! Returns the path for @[obj] in @[fc], if it got any.
{
if (sizeof (rev_fc) < sizeof (fc)) {
foreach (fc; string path; mixed obj)
if (obj == no_value)
m_delete (fc, obj);
else
rev_fc[obj] = path;
}
return rev_fc[obj];
}
array(string) query_precompiled_names(string fname)
//! Returns identifiers (e.g. file names) of potentially precompiled
//! files in priority order.
{
#ifdef PRECOMPILED_SEARCH_MORE
// Search for precompiled files in all module directories, not just
// in the one where the source file is. This is useful when running
// pike directly from the build directory.
fname = fakeroot (fname);
// FIXME: Not sure if this works correctly with the fakeroot and
// module relocation stuff.
foreach (pike_module_path, string path)
if (has_prefix (fname, path))
return map (pike_module_path, `+, "/", fname[sizeof (path)..], ".o");
#endif
return ({ fname + ".o" });
}
int get_precompiled_mtime (string id)
//! Given an identifier returned by query_precompiled_names, returns
//! the mtime of the precompiled entry. Returns -1 if there is no
//! entry.
{
Stat s = master_file_stat (fakeroot (id));
return s && s->isreg ? s->mtime : -1;
}
string read_precompiled (string id)
//! Given an identifier returned by query_precompiled_names, returns
//! the precompiled entry. Can assume the entry exists.
{
return master_read_file (id);
}
protected class CompileCallbackError
{
inherit _static_modules.Builtin.GenericError;
constant is_generic_error = 1;
constant is_compile_callback_error = 1;
constant is_cpp_or_compilation_error = 1;
}
protected void compile_cb_error (string msg, mixed ... args)
// Use this to throw errors that should be converted to plain compile
// error messages, without backtraces being reported by
// compile_exception.
{
if (sizeof (args)) msg = sprintf (msg, @args);
throw (CompileCallbackError (msg, backtrace()[..<1]));
}
protected void compile_cb_rethrow (object|array err)
// Use this to rethrow errors that should be converted to plain
// compile error messages, without backtraces being reported by
// compile_exception.
{
array bt;
if (array|object e = catch (bt = get_backtrace (err)))
handle_error (e);
throw (CompileCallbackError (call_describe_error (err), bt));
}
protected void call_compile_warning (object handler, string file,
string msg, mixed ... args)
{
if (sizeof (args)) msg = sprintf (msg, @args);
msg = trim_all_whites (msg);
if (handler?->compile_warning)
handler->compile_warning (file, 0, msg);
else if (master()->compile_warning)
master()->compile_warning (file, 0, msg);
else
compile_warning (file, 0, msg);
}
#if constant(_static_modules.Builtin.mutex)
#define THREADED
#endif
#ifdef __NT__
#define FIX_CASE(X) lower_case(X)
#else
#define FIX_CASE(X) (X)
#endif /* __NT__ */
protected string base_from_filename(string fname)
{
string low_name = FIX_CASE(fname);
if (has_prefix(low_name, ".#")) return 0;
if (has_suffix(low_name, ".pike") ||
has_suffix(low_name, ".pmod")) {
return fname[..<5];
}
if (has_suffix(low_name, ".so")) {
return fname[..<3];
}
return 0;
}
protected int prio_from_filename(string fname)
{
fname = FIX_CASE(fname);
if (has_suffix(fname, ".pmod")) return 3;
if (has_suffix(fname, ".so")) return 2;
if (has_suffix(fname, ".pike")) return 1;
// FIXME: Warn here?
return 0;
}
//! Find the files in which @[mod] is defined, as they may be hidden away in
//! joinnodes and dirnodes
//!
//! @param mod
//! The module we are looking for.
//!
//! @returns
//! An array of strings with filenames.
//! (one for each file in a joinnode, or just one otherwise)
array(string) module_defined(object|program mod)
{
array files = ({});
if (programp(mod))
return ({ Builtin.program_defined([program]mod) });
array mods;
if (objectp(mod) && object_program(mod)->is_resolv_joinnode)
mods = mod->joined_modules;
else
mods = ({ mod });
foreach (mods;; object mod)
{
if (objectp(mod) && object_program(mod)->is_resolv_dirnode)
files += ({ Builtin.program_defined(object_program(mod->module)) });
else
files += ({ Builtin.program_defined(object_program(mod)) });
}
return files;
}
//! Enable caching of sources from compile_string()
void enable_source_cache()
{
if (!source_cache)
source_cache = ([]);
}
//! Show documentation for the item @[obj]
//!
//! @param obj
//! The object for which the documentation should be shown
//!
//! @returns
//! an AutoDoc object
object show_doc(program|object|function obj)
{
object doc_extractor = main_resolv("Tools.AutoDoc.PikeExtractor.extractClass");
string child;
program prog;
if (programp(obj))
prog = obj;
if (functionp(obj))
{
prog = function_program(obj);
child = ((describe_function(obj)||"")/"->")[-1];
}
if (objectp(obj))
{
if (object_program(obj)->is_resolv_joinnode)
obj = obj->joined_modules[0]; // FIXME: check for multiples
if (object_program(obj)->is_resolv_dirnode)
prog = object_program(obj->module);
else
prog = object_program(obj);
}
if (prog && !documentation[prog] && doc_extractor)
{
string source;
if (source_cache && source_cache[prog])
source = source_cache[prog];
else
{
array sourceref = array_sscanf(Builtin.program_defined(prog),
"%s%[:]%[0-9]");
source = master_read_file(sourceref[0]);
if (sizeof(sourceref[1]) && sizeof(sourceref[2]))
{
if (programp(prog))
child = ((describe_program(prog)||"")/".")[-1];
}
}
if (source)
{
catch
{
documentation[prog] = doc_extractor(source, sprintf("%O", prog));
};
//FIXME: handle this error somehow
}
}
if (documentation[prog])
{
if (child)
return documentation[prog]->findObject(child)||documentation[prog]->findChild(child);
else
return documentation[prog];
}
}
// Make it possible to customize the backtrace formatting.
protected string call_describe_backtrace(array(mixed) trace,
void|int linewidth)
{
return (all_constants()["describe_backtrace"]||describe_backtrace)
(trace, linewidth);
}
protected string call_describe_error(mixed /* object|array */ err)
{
return (all_constants()["describe_error"]||describe_error)(err);
}
protected object lock_compiler()
{
// Compat with older Pike 8.0 binaries.
if (DefaultCompilerEnvironment->lock) {
return DefaultCompilerEnvironment->lock();
}
return UNDEFINED;
}
protected program low_findprog(string pname,
string ext,
object|void handler,
void|int mkobj)
{
program ret;
Stat s;
string fname=pname+ext;
resolv_debug("low_findprog(%O, %O, %O, %O)\n",
pname, ext, handler, mkobj);
#ifdef PIKE_MODULE_RELOC
fname = unrelocate_module(fname);
#endif
#ifdef __NT__
// Ugly kluge to work better with cygwin32 "/X:/" paths.
if(getenv("OSTYPE")=="cygwin32")
{
string tmp=fname[..1];
if((tmp=="//" || tmp=="\\\\") && (fname[3]=='/' || fname[3]=='\\'))
{
if(!master_file_stat(fname))
{
fname=fname[2..2]+":"+fname[3..];
}
}
}
#endif
if( (s=master_file_stat(fakeroot(fname))) && s->isreg )
{
#ifdef PIKE_AUTORELOAD
if(!autoreload_on || load_time[fname] >= s->mtime)
#endif
{
if(!undefinedp (ret=programs[fname]) && ret != no_value) {
resolv_debug ("low_findprog %s: returning cached (no autoreload)\n", fname);
return ret;
}
}
AUTORELOAD_BEGIN();
#ifdef PIKE_AUTORELOAD
if (load_time[fname] >= s->mtime)
if (!undefinedp (ret=programs[fname]) && ret != no_value) {
resolv_debug ("low_findprog %s: returning cached (autoreload)\n", fname);
return ret;
}
#endif
object compiler_lock = lock_compiler();
if(!undefinedp(ret = programs[fname]) && (ret != no_value)) {
destruct(compiler_lock);
resolv_debug("low_findprog %s: returning cached (from other thread).\n",
fname);
return ret;
}
switch(ext)
{
case "":
case ".pike":
foreach(query_precompiled_names(fname), string oname) {
int o_mtime = get_precompiled_mtime (oname);
if (o_mtime >= 0) {
if (o_mtime >= s->mtime) {
mixed err=catch {
object|program decoded;
AUTORELOAD_CHECK_PRECOMPILED_FILE (oname);
resolv_debug ("low_findprog %s: decoding dumped\n", fname);
INC_RESOLV_MSG_DEPTH();
decoded = decode_value(read_precompiled (oname),
(handler?->get_codec ||
get_codec)(fname, mkobj, handler));
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("low_findprog %s: dump decode ok\n", fname);
if (decoded?->this_program_does_not_exist) {
resolv_debug ("low_findprog %s: program claims not to exist\n",
fname);
return programs[fname] = 0;
}
else {
if (objectp(decoded)) {
resolv_debug("low_findprog %s: decoded object %O\n",
fname, decoded);
objects[ret = object_program(decoded)] = decoded;
} else {
ret = decoded;
}
resolv_debug("low_findprog %s: returning %O\n", fname, ret);
return programs[fname]=ret;
}
};
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("low_findprog %s: dump decode failed\n", fname);
programs[fname] = no_value;
call_compile_warning (handler, oname,
"Decode failed: " +
call_describe_error(err));
// handle_error(err);
} else if (out_of_date_warning) {
call_compile_warning (handler, oname,
"Compiled file is out of date");
}
}
}
resolv_debug ("low_findprog %s: compiling, mkobj: %O\n", fname, mkobj);
INC_RESOLV_MSG_DEPTH();
programs[fname]=ret=__empty_program(0, fname);
AUTORELOAD_CHECK_FILE (fname);
string src;
if (array|object err = catch (src = master_read_file (fname))) {
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("low_findprog %s: failed to read file\n", fname);
objects[ret] = no_value;
ret=programs[fname]=0; // Negative cache.
compile_cb_rethrow (err);
}
if ( mixed e=catch {
ret=compile_string(src, fname, handler,
ret,
mkobj? (objects[ret]=__null_program()) : 0);
} )
{
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("low_findprog %s: compilation failed\n", fname);
objects[ret] = no_value;
ret=programs[fname]=0; // Negative cache.
destruct(compiler_lock);
throw(e);
}
destruct(compiler_lock);
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("low_findprog %s: compilation ok\n", fname);
break;
#if constant(load_module)
case ".so":
if (fname == "") {
werror( "low_findprog(%O, %O) => load_module(\"\")\n"
"%s\n", pname, ext, call_describe_backtrace(backtrace()) );
}
if (array|object err = catch (ret = load_module(fakeroot(fname)))) {
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("low_findprog %s: failed to load binary\n", fname);
objects[ret] = no_value;
ret=programs[fname]=0; // Negative cache.
if (objectp (err) && err->is_module_load_error)
// Do not treat errors from dlopen(3) as exceptions since in
// a dist we can have .so files that are dynamically linked
// against libraries that don't exist on the system, and in
// that case we should just treat the module as nonexisting.
//
// What we really want is to do this only for errors that
// are due to nonexisting files, but the error reporting
// from dlerror(3) doesn't allow us to tell those from other
// errors.
call_compile_warning (handler, fname,
"Failed to load library: %s\n", err->reason);
else
compile_cb_rethrow (err);
}
else
resolv_debug ("low_findprog %s: loaded binary\n", fname);
#endif /* load_module */
}
AUTORELOAD_FINISH(ret,programs,fname);
if (ret?->this_program_does_not_exist) {
resolv_debug ("low_findprog %s: program says it doesn't exist\n", fname);
return programs[fname] = 0;
}
else {
if(!ret)
resolv_debug("low_findprog %s: dependencies failed.\n", fname);
else
resolv_debug("low_findprog %s: returning %O\n", fname, ret);
return programs[fname]=ret;
}
}
resolv_debug ("low_findprog %s: file not found\n", fname);
return 0;
}
//
// This function is called by the compiler when a delayed compilation
// error occurs in the given program. It should remove all references
// to the program so that it can be freed.
//
void unregister(program p)
{
// werror("Unregistering %O...\n", p);
object compiler_lock = lock_compiler();
if(string fname=rev_programs[p] || search(programs,p)) {
resolv_debug("unregister %s\n", fname);
if (m_delete (rev_programs, p))
m_delete (programs, fname);
else
programs[fname] = no_value;
string name = program_path_to_name (fname);
mixed n = has_value (name, ".") ?
resolv ((name / ".")[..<1] * ".") :
get_root_module();
if (objectp (n) && (object_program(n)->is_resolv_dirnode ||
object_program(n)->is_resolv_joinnode))
n->delete_value (p);
fname = dirname (fname);
if ( fname!="" && objectp (n = fc[fname]) )
if (object_program(n)->is_resolv_dirnode) // Won't find joinnodes in fc.
n->delete_value (p);
}
object o = m_delete(objects, p);
if (objectp (o)) {
m_delete(rev_objects, o);
}
foreach (fc; string name; mixed mod)
if (objectp(mod) && object_program(mod) == p)
if (m_delete (rev_fc, mod))
m_delete (fc, name);
else
fc[name] = no_value;
// FIXME: What about compat handlers?
}
protected program findprog(string pname,
string ext,
object|void handler,
void|int mkobj)
{
switch(ext)
{
case ".pike":
case ".so":
return low_findprog(pname,ext,handler, mkobj);
default:
pname+=ext;
return
low_findprog(pname,"", handler, mkobj) ||
low_findprog(pname,".pike", handler, mkobj) ||
low_findprog(pname,".so", handler, mkobj);
}
}
program low_cast_to_program(string pname,
string current_file,
object|void handler,
void|int mkobj)
{
string ext;
string nname;
//werror("low_cast_to_program(%O, %O, %O, %O)\n",
// pname, current_file, handler, mkobj);
if(sscanf(reverse(BASENAME(pname)),"%s.%s",ext, nname))
{
ext="."+reverse(ext);
pname=pname[.. %O\n", pname, current_file, ret);
if (programp (ret)) return ret;
error("Cast %O to program failed%s.\n",
pname,
(current_file && current_file!="-") ? sprintf(" in %O",current_file) : "");
}
protected string narrowify_string(string s)
{
if (Builtin.string_width(s) <= 8) return s;
// Perform Unicode escaping.
return map(s/"",
lambda(string s) {
if (Builtin.string_width(s) <= 8) return s;
int c = s[0] & 0xffffffff;
if (c <= 0xffff) return sprintf("\\u%04x", c);
return sprintf("\\U%08x", c);
}) * "";
}
//! This function is called when an error occurs that is not caught
//! with catch().
void handle_error(array|object trace)
{
// NB: Use predef::trace() to modify trace level here.
// predef::trace(2);
if(mixed x=catch {
werror(call_describe_backtrace(trace));
}) {
// One reason for this might be too little stack space, which
// easily can occur for "out of stack" errors. It should help to
// tune up the STACK_MARGIN values in interpret.c then.
werror("Error in handle_error in master object:\n");
if(catch {
// NB: Splited werror calls to retain some information
// even if/when werror throws.
catch {
if (catch {
string msg = [string]x[0];
array bt = [array]x[1];
werror("%s", narrowify_string(msg));
werror(narrowify_string(sprintf("%O\n", bt)));
}) {
werror(narrowify_string(sprintf("%O\n", x)));
}
};
werror(narrowify_string(sprintf("Original error:\n"
"%O\n", trace)));
}) {
werror("sprintf() failed to write error.\n");
}
}
// predef::trace(0);
}
/* This array contains the names of the functions
* that a replacing master-object may want to override.
*/
constant master_efuns = ({
"error",
"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",
"describe_error",
"get_backtrace",
"normalize_path",
"bool",
"true",
"false",
"getenv",
"putenv",
#ifdef GETCWD_CACHE
"cd",
"getcwd",
#endif
});
typedef int(0..1) bool;
enum { false=0, true=1 };
//! Prefix for Pike-related C header files.
string include_prefix;
//! Prefix for autodoc files.
string doc_prefix;
//! Flags suitable for use when compiling Pike C modules
string cflags;
//! Flags suitable for use when linking Pike C modules
string ldflags; // Not yet used
//! @decl int strlen(string|multiset|array|mapping|object thing)
//! @appears strlen
//! Alias for @[sizeof].
//! @deprecated sizeof
//! @decl int write(string fmt, mixed ... args)
//! @appears write
//! Writes a string on stdout. Works just like @[Stdio.File.write]
//! on @[Stdio.stdout].
//! @decl int werror(string fmt, mixed ... args)
//! @appears werror
//! Writes a string on stderr. Works just like @[Stdio.File.write]
//! on @[Stdio.stderr].
/* Note that create is called before add_precompiled_program
*/
protected void create()
{
foreach(master_efuns, string e)
if (has_index(this, e))
add_constant(e, this[e]);
else
error("Function %O is missing from master.pike.\n", e);
add_constant("__dirnode", dirnode);
add_constant("__joinnode", joinnode);
add_constant("write", write);
add_constant("werror", werror);
// To make it possible to overload get_dir and file_stat later on.
// It's not possible to replace efuns with normal functions in .o-files
add_constant("get_dir", master_get_dir );
add_constant("file_stat", lambda( string f, int|void d ) { return file_stat(f,d);} );
#define CO(X) add_constant(#X,Builtin.__backend->X)
CO(call_out);
CO(_do_call_outs);
CO(find_call_out);
CO(remove_call_out);
CO(call_out_info);
#if "#share_prefix#"[0]!='#'
// add path for architecture-independant 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
// Debian paths
add_include_path("/usr/local/lib/pike"+__REAL_MAJOR__+"."+__REAL_MINOR__+"/include");
add_module_path("/usr/local/lib/pike"+__REAL_MAJOR__+"."+__REAL_MINOR__+"/modules");
#if "#cflags# "[0]!='#'
cflags = "#cflags#";
#endif
#if "#ldflags# "[0]!='#'
ldflags = "#ldflags#";
#endif
#if "#include_prefix#"[0]!='#'
include_prefix = "#include_prefix#";
cflags = (cflags || "") + " -I" + dirname(include_prefix);
#endif
#if "#doc_prefix#"[0]!='#'
doc_prefix = "#doc_prefix#";
#endif
#if constant(__embedded_resource_directory)
// for use with embedded interpreters
// add path for architecture-dependant files
add_include_path(__embedded_resource_directory + "/lib/include");
add_module_path(__embedded_resource_directory + "/lib/modules");
add_module_path(__embedded_resource_directory + "/" + replace(uname()->machine, " ", "_") + "/modules");
#endif
system_module_path=pike_module_path;
}
//! 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, object|void handler)
{
resolv_debug ("handle_inherit(%O, %O)\n", pname, current_file);
INC_RESOLV_MSG_DEPTH();
program ret = cast_to_program(pname, current_file, handler);
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("handle_inherit(%O, %O) => %O\n", pname, current_file, ret);
return ret;
}
object low_cast_to_object(string oname, string current_file,
object|void current_handler)
{
program p;
object o;
p = low_cast_to_program(oname, current_file, current_handler, 1);
if(!p) return 0;
if(!objectp(o = objects[p])) {
object compiler_lock = lock_compiler();
// NB: p might be a function in a fake_object...
if(!objectp(o = objects[p])) o = objects[p] = p();
destruct(compiler_lock);
}
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,
object|void current_handler)
{
resolv_debug ("cast_to_object(%O, %O)\n", oname, current_file);
INC_RESOLV_MSG_DEPTH();
object o = low_cast_to_object(oname, current_file, current_handler);
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("cast_to_object(%O, %O) => %O\n", oname, current_file, o);
if (objectp (o)) return o;
error("Cast %O to object failed%s.\n",
oname,
(current_file && current_file!="-") ? sprintf(" in %O",current_file) : "");
}
// Marker used for negative caching in module caches.
// FIXME: Won't this cause problems when inheriting "/master"?
protected class ZERO_TYPE {};
protected object Unicode;
//! Module node representing a single directory.
//!
//! @seealso
//! @[joinnode]
class dirnode (string dirname, object|void compilation_handler,
string|void name)
{
constant is_resolv_dirnode = 1;
// objectp() is intentionally not used on the module object, to
// allow a module to deny its own existence with `!.
mixed module;
mapping(string:mixed) cache=([]);
mapping(string:array(string)) file_paths = ([]);
#ifdef __NT__
#define FIX_CASE(X) lower_case(X)
#else
#define FIX_CASE(X) (X)
#endif /* __NT__ */
protected string base_from_filename(string fname)
{
string low_name = FIX_CASE(fname);
catch {
// FIXME: Warn on failure?
low_name = utf8_to_string(low_name);
if (Builtin.string_width(low_name) > 8) {
// We might need to normalize the string (cf MacOS X).
// Load the Unicode module if it hasn't already been loaded.
if (!Unicode) {
Unicode = resolv("Unicode");
}
low_name = Unicode.normalize(low_name, "NFC");
}
};
if (has_prefix(low_name, ".#")) return 0;
if (has_suffix(low_name, ".pike") ||
has_suffix(low_name, ".pmod")) {
return fname[..<5];
}
if (has_suffix(low_name, ".so")) {
return fname[..<3];
}
return 0;
}
protected int prio_from_filename(string fname)
{
fname = FIX_CASE(fname);
if (has_suffix(fname, ".pmod")) return 3;
if (has_suffix(fname, ".so")) return 2;
if (has_suffix(fname, ".pike")) return 1;
// FIXME: Warn here?
return 0;
}
protected void create()
{
if (!dirname) {
error("Attempt to create a dirnode without a directory.\n"
"Have you inherited a dirnode?\n");
}
resolv_debug ("dirnode(%O,%O) created with name %O\n", dirname,
compilation_handler, name);
fc[dirname]=this;
array(string) files = sort(master_get_dir(dirname)||({}));
if (!sizeof(dirname)) return;
array(string) bases = map(files, base_from_filename);
files = filter(files, bases);
bases = filter(bases, bases);
resolv_debug("dirnode(%O,%O) got %d files.\n",
dirname, compilation_handler, sizeof(bases));
if (!sizeof(files)) return;
foreach(files; int no; string fname) {
fname = combine_path(dirname, fname);
string base = bases[no];
if (base == "module") {
// We need a module_checker.
module = module_checker();
}
array(string) paths = file_paths[base];
if (!paths) {
// New entry.
file_paths[base] = ({ fname });
continue;
}
// Multiple files. Order according to prio_from_filename().
// Insert sort. Worst case is 3 filenames.
int prio = prio_from_filename(fname);
int index;
foreach(paths; index; string other_fname) {
if (prio_from_filename(other_fname) <= prio) break;
}
file_paths[base] = paths[..index-1] + ({ fname }) + paths[index..];
}
}
class module_checker
{
protected int `!()
{
resolv_debug ("dirnode(%O)->module_checker()->`!()\n",dirname);
if (mixed err = catch {
// Look up module.
if (module = cache["module"] || low_ind("module", 1)) {
/* This allows for `[] to have side effects first time
* it is called. (Specifically, the Calendar module uses
* this).
*/
cache=([]);
_cache_full=0;
}
resolv_debug("dirnode(%O)->module_checker()->`!() => %s\n",
dirname, !module ? "doesn't exist" : "exists");
return !module;
}) {
//werror ("findmodule error: " + call_describe_backtrace (err));
// findmodule() failed. This can occur due to circularities
// between encode_value()'ed programs.
// The error will then typically be:
// "Cannot call functions in unfinished objects."
// Pretend not to exist for now...
resolv_debug("dirnode(%O)->module_checker()->`!() => failure, doesn't exist\n",
dirname);
return 1;
}
}
protected mixed `[](string index)
{
resolv_debug ("dirnode(%O)->module_checker()[%O] => %O\n",
dirname, index, module[?index]);
return module[?index];
}
protected array(string) _indices() { if(module) return indices(module); }
protected array _values() { if(module) return values(module); }
}
protected mixed low_ind(string index, int(0..1)|void set_module)
{
array(string) paths;
INC_RESOLV_MSG_DEPTH();
if (!(paths = file_paths[index])) {
DEC_RESOLV_MSG_DEPTH();
resolv_debug("dirnode(%O)->ind(%O) => no file match\n",
dirname, index);
return UNDEFINED;
}
foreach(paths, string fname) {
resolv_debug("dirnode(%O)->ind(%O) Trying file %O...\n",
dirname, index, fname);
Stat stat = master_file_stat(fakeroot(fname));
if (!stat) {
resolv_debug("dirnode(%O)->ind(%O) file %O disappeared!\n",
dirname, index, fname);
continue;
}
if (has_suffix(fname, ".pmod")) {
if (stat->isdir) {
if (dirnode n = fc[fname]) {
// Avoid duplicate dirnodes for the same dirs. This can
// happen if the master is replaced, e.g. with master_76
// in 7.6/modules/__default.pmod.
resolv_debug("dirnode(%O)->ind(%O) => found subdirectory %O, "
"returning old dirnode\n", dirname, index, fname);
return n;
}
resolv_debug("dirnode(%O)->ind(%O) => found subdirectory %O, "
"creating new dirnode\n", dirname, index, fname);
return fc[fname] = dirnode(fname, compilation_handler,
name && (name == "predef::" ?
index : name + "." + index));
}
resolv_debug("dirnode(%O)->ind(%O) casting (object)%O\n",
dirname, index, fname);
// FIXME: cast_to_program() and cast_to_object()
// have lots of overhead to guess the proper
// filename. This overhead isn't needed in
// our cases, so we could make do with
// low_findprog() and the caches.
mixed ret;
if (ret = catch {
if (objectp(ret = low_cast_to_object(fname, 0, compilation_handler))) {
// This assignment is needed for eg the Calendar module.
if (set_module) module = ret;
if(mixed tmp=ret->_module_value) ret=tmp;
DEC_RESOLV_MSG_DEPTH();
resolv_debug("dirnode(%O)->ind(%O) => found submodule %O:%O\n",
dirname, index, fname, ret);
return ret;
}
}) {
resolv_debug("dirnode(%O)->ind(%O) ==> Cast to object failed: %s\n",
dirname, index, call_describe_backtrace(ret));
}
} else {
resolv_debug("dirnode(%O)->ind(%O) casting (program)%O\n",
dirname, index, fname);
program|object ret;
if (ret = low_cast_to_program(fname, 0, compilation_handler)) {
DEC_RESOLV_MSG_DEPTH();
resolv_debug("dirnode(%O)->ind(%O) => found subprogram %O:%O\n",
dirname, index, fname, ret);
#if constant(load_module)
if (has_suffix(fname, ".so")) {
// This is compatible with 7.4 behaviour.
if (!ret->_module_value) {
object o;
// NB: p might be a function in a fake_object...
if(!objectp(o = objects[ret])) {
object compiler_lock = lock_compiler();
if(!objectp(o = objects[ret])) o = objects[ret] = ret();
destruct(compiler_lock);
}
ret = o;
}
if(mixed tmp=ret->_module_value) ret=tmp;
}
#endif
return ret;
}
}
resolv_debug("dirnode(%O)->ind(%O) => failure for file %O\n",
dirname, index, fname);
}
resolv_debug("dirnode(%O)->ind(%O) => UNDEFINED\n",
dirname, index);
return UNDEFINED;
}
protected mixed ind(string index)
{
resolv_debug ("dirnode(%O)->ind(%O)\n", dirname, index);
INC_RESOLV_MSG_DEPTH();
if (_cache_full) {
DEC_RESOLV_MSG_DEPTH();
resolv_debug("dirnode(%O)->ind(%O) => cache_full %O\n",
dirname, index, cache[index]);
return cache[index];
}
if(module)
{
mixed o;
// _describe(module);
if(!undefinedp(o=module[index]))
{
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("dirnode(%O)->ind(%O) => found %O\n",
dirname, index, o);
return o;
}
resolv_debug ("dirnode(%O)->ind(%O) => not found in module\n",
dirname, index);
}
else
resolv_debug ("dirnode(%O)->ind(%O) => no module\n", dirname, index);
DEC_RESOLV_MSG_DEPTH();
return low_ind(index);
}
protected mixed `[](string index)
{
mixed ret;
#ifdef MODULE_TRACE
werror("%*nDirnode(%O) cache[%O] ?????\n",
sizeof(backtrace()),dirname,index);
#endif
if(!undefinedp(ret=cache[index]))
{
#ifdef MODULE_TRACE
werror("%*nDirnode(%O) cache[%O] => %O%s\n",
sizeof(backtrace()),dirname,index, ret,
(ret != ZERO_TYPE)?"":" (zero_type)");
#endif
if (ret != ZERO_TYPE) return ret;
#ifdef MODULE_TRACE
werror("%*nDirnode(%O) ZERO_TYPE!\n",
sizeof(backtrace()),dirname);
#endif
return UNDEFINED;
}
ret=ind(index);
// We might have gotten placeholder objects in the first pass
// which must not be cached to the second.
if(ret == predef::__placeholder_object) {
#ifdef MODULE_TRACE
werror("%*nDirnode(%O) PLACE_HOLDER.\n",
sizeof(backtrace()),dirname);
#endif
return ret;
}
cache[index] = undefinedp(ret) ? ZERO_TYPE : ret;
return ret;
}
mixed safe_index(string index)
{
mixed err;
resolv_debug ("dirnode(%O): %O...\n", dirname, index);
if (err = catch { return `[](index); }) {
call_compile_warning (compilation_handler,
dirname+"."+fname,
"Compilation failed: " +
call_describe_error(err));
}
return UNDEFINED;
}
protected int(0..1) _cache_full;
void fill_cache()
{
#if 0
werror(call_describe_backtrace(({ sprintf("Filling cache in dirnode %O\n",
dirname),
backtrace() })));
#endif
if (_cache_full) {
return;
}
resolv_debug ("dirnode(%O) => Filling cache...\n", dirname);
// NOTE: We rely on side effects in `[]() and safe_index()
// to fill the cache.
// Why shouldn't thrown errors be propagated here? /mast
if (module) {
resolv_debug("dirnode(%O): module: %O, indices:%{%O, %}\n",
dirname, module, indices(module));
map(indices(module), safe_index);
}
map(indices(file_paths), safe_index);
_cache_full = (object_program(module) != __null_program);
resolv_debug ("dirnode(%O) => Cache %s.\n", dirname,
_cache_full?"full":"partially filled");
}
protected array(string) _indices()
{
fill_cache();
// Note: Cannot index cache at all here to filter out the
// ZERO_TYPE values since that can change the order in the
// mapping, and _indices() has to return the elements in the same
// order as a nearby _values() call.
return filter (indices (cache), map (values (cache), `!=, ZERO_TYPE));
}
protected array(mixed) _values()
{
fill_cache();
return values(cache) - ({ZERO_TYPE});
}
void delete_value (mixed val)
{
if (string name = search (cache, val)) {
m_delete (cache, name);
_cache_full = 0;
}
}
protected int(0..) _sizeof() {
return sizeof(_values());
}
protected string _sprintf(int as)
{
return as=='O' && (name || sprintf("master()->dirnode(%O:%O)",
dirname, module && module));
}
}
//! Module node holding possibly multiple directories,
//! and optionally falling back to another level.
//!
//! @seealso
//! @[dirnode]
class joinnode (array(object|mapping) joined_modules,
object|void compilation_handler,
joinnode|mapping(mixed:int(0..0))|void fallback_module,
string|void name)
{
constant is_resolv_joinnode = 1;
mapping(string:mixed) cache=([]);
protected string _sprintf(int as)
{
if (as != 'O') return 0;
if (name) {
if (has_value (name, "|"))
return "joinnode(" + name + ")";
else
return name; // Let's be brief.
}
else
return sprintf("master()->joinnode(%O)", joined_modules);
}
protected void create()
{
if( !fallback_module ) {
// NOTE: Uses the empty mapping as the default fallback
// for simplified code.
fallback_module = ([]);
}
if (!joined_modules) {
error("Attempt to create a joinnode without joined modules.\n"
"Have you inherited a joinnode?\n");
}
if (!name)
{
mapping(string:int(1..1)) names = ([]);
foreach (joined_modules, object|mapping m) {
if (objectp (m) && stringp (m->name))
names[m->name] = 1;
}
if (sizeof (names))
name = sort (indices (names)) * "|";
}
resolv_debug ("joinnode(%O) created with name %O\n", joined_modules, name);
}
void add_path(string path)
{
path = combine_path(getcwd(), path);
dirnode node = fc[path] ||
(fc[path] = dirnode(path, compilation_handler,
name && !has_value (name, "|") && name));
if (sizeof(joined_modules) &&
joined_modules[0] == node) return;
joined_modules = ({ node }) + (joined_modules - ({ node }));
cache = ([]);
}
void rem_path(string path)
{
path = combine_path(getcwd(), path);
joined_modules = filter(joined_modules,
lambda(dirnode node) {
return !objectp(node) ||
!object_program(node)->is_resolv_dirnode ||
(node->dirname != path);
});
cache = ([]);
}
protected mixed ind(string index)
{
resolv_debug ("joinnode(%O)->ind(%O)\n", joined_modules, index);
INC_RESOLV_MSG_DEPTH();
array(mixed) res = ({});
foreach(joined_modules, object|mapping o)
{
mixed ret;
if (!undefinedp(ret = o[index]))
{
if (objectp(ret) &&
(object_program(ret)->is_resolv_dirnode ||
object_program(ret)->is_resolv_joinnode))
{
// Only join directorynodes (or joinnodes).
res += ({ ret });
} else {
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("joinnode(%O)->ind(%O) => found %O\n",
joined_modules, index, ret);
return (ret);
}
}
}
if (sizeof(res)) {
DEC_RESOLV_MSG_DEPTH();
resolv_debug("joinnode(%O)->ind(%O) => new joinnode, fallback: %O\n",
joined_modules, index, fallback_module[index]);
return joinnode(res, compilation_handler, fallback_module[index],
name && !has_value (name, "|") &&
(name == "predef::" ? index : name + "." + index));
}
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("joinnode(%O)->ind(%O) => not found. Trying fallback %O\n",
joined_modules, index, fallback_module);
return fallback_module[index];
}
protected mixed `[](string index)
{
mixed ret;
if (!undefinedp(ret = cache[index])) {
if (ret != ZERO_TYPE) {
return ret;
}
return UNDEFINED;
}
ret = ind(index);
// We might have gotten placeholder objects in the first pass
// which must not be cached to the second.
if(ret == predef::__placeholder_object) return ret;
if (undefinedp(ret)) {
cache[index] = ZERO_TYPE;
} else {
cache[index] = ret;
}
return ret;
}
protected int _cache_full;
void fill_cache()
{
#if 0
werror(call_describe_backtrace(({ "Filling cache in joinnode\n",
backtrace() })));
#endif
if (_cache_full) {
return;
}
foreach(joined_modules, object|mapping|program o) {
foreach(indices(o), string index) {
if (!has_index(cache, index)) {
`[](index);
}
}
}
foreach(indices(fallback_module), string index) {
`[](index);
}
_cache_full = 1;
}
protected array(string) _indices()
{
fill_cache();
// Note: Cannot index cache at all here to filter out the
// ZERO_TYPE values since that can change the order in the
// mapping, and _indices() has to return the elements in the same
// order as a nearby _values() call.
return filter (indices (cache), map (values (cache), `!=, ZERO_TYPE));
}
protected array(mixed) _values()
{
fill_cache();
return values(cache) - ({ZERO_TYPE});
}
void delete_value (mixed val)
{
if (string name = search (cache, val))
m_delete (cache, name);
for (int i = 0; i < sizeof (joined_modules); i++) {
object|mapping|program o = joined_modules[i];
if (o == val) {
joined_modules = joined_modules[..i - 1] + joined_modules[i + 1..];
i--;
}
else if (objectp (o) && (object_program(o)->is_resolv_dirnode ||
object_program(o)->is_resolv_joinnode))
o->delete_value (val);
else if (string name = mappingp (o) && search (o, val))
m_delete (o, name);
}
}
protected int `== (mixed other)
{
// NB: Index the program instead of the object to avoid issues
// with modules overloading lfun::`->() with stuff that has
// side-effects (here's looking at you Calendar.Events).
return objectp (other) &&
(object_program(other)->is_resolv_joinnode == 1) &&
equal (mkmultiset (joined_modules), mkmultiset (other->joined_modules));
}
array(object) _encode()
{
return joined_modules;
}
void _decode (array(object) joined_modules)
{
this::joined_modules = joined_modules;
}
}
joinnode handle_import(string path, string|void current_file,
object|void current_handler)
{
#ifdef __amigaos__
if(path == ".")
path = "";
#endif
if(current_file)
{
path = combine_path_with_cwd(dirname(current_file), path);
} else {
path = combine_path_with_cwd(path);
}
// FIXME: Need caching!!!
#if 0
// FIXME: This caching strategy could be improved,
// since it ignores module_nodes from the
// ordinary module tree.
if (module_node_cache[current_handler]) {
if (module_node_cache[current_handler][path]) {
return module_node_cache[current_handler][path];
}
} else {
module_node_cache[current_handler] = ([]);
}
module_node node = module_node_cache[current_handler][path] =
module_node("import::"+path, 0, current_handler);
#endif /* 0 */
joinnode node = joinnode(({}), current_handler);
#ifdef PIKE_MODULE_RELOC
// If we have PIKE_MODULE_RELOC enabled,
// we might need to map to multiple directories.
if(path == "/${PIKE_MODULE_PATH}" ||
has_prefix(path, "/${PIKE_MODULE_PATH}/")) {
string tmp = path[21..];
foreach(pike_module_path, string prefix) {
node->add_path(sizeof(tmp)? combine_path(prefix, tmp) : prefix);
}
} else
#endif /* PIKE_MODULE_RELOC */
node->add_path(path);
return node;
}
program|object findmodule(string fullname, object|void handler,
void|string name)
{
program|object o;
resolv_debug ("findmodule(%O)\n", fullname);
if(!undefinedp(o=fc[fullname]) && o != no_value)
{
if (objectp(o) || programp(o) || o != 0) {
resolv_debug ("findmodule(%O) => found %O (cached)\n", fullname, o);
return o;
}
resolv_debug ("findmodule(%O) => not found (cached)\n", fullname);
return UNDEFINED;
}
if(Stat stat=master_file_stat(fakeroot(fullname)))
{
if(stat->isdir)
{
resolv_debug ("findmodule(%O) => new dirnode\n", fullname);
return fc[fullname] = dirnode(fullname, handler, name);
}
#if constant (load_module)
else if (has_suffix (fullname, ".so")) {
o = fc[fullname] = low_cast_to_object(fullname, "/.", handler);
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("findmodule(%O) => got .so object %O\n", fullname, o);
return o;
}
#endif
}
INC_RESOLV_MSG_DEPTH();
if(objectp (o = low_cast_to_object(fullname, "/.", handler))) {
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("findmodule(%O) => got object %O\n", fullname, o);
return fc[fullname]=o;
}
if (programp (o = low_cast_to_program(fullname, "/.", handler))) {
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("findmodule(%O) => got .pike program %O\n", fullname, o);
return fc[fullname] = o;
}
DEC_RESOLV_MSG_DEPTH();
resolv_debug ("findmodule(%O) => not found\n", fullname);
return fc[fullname] = 0;
}
#if 0
mixed handle_import(string what, string|void current_file, object|void handler)
{
string path;
if(current_file)
{
path = combine_path_with_cwd(dirname(current_file), what);
} else {
path = combine_path_with_cwd(what);
}
#if 0
// If we can't cache the dirnode when we got a handler, then
// findmodule has to be broken too. Good caching is necessary for
// module dumping. /mast
if (handler) {
resolv_debug ("handle_import(%O, %O, %O) => new dirnode with handler\n",
what, current_file, handler);
return dirnode(path, handler);
}
#endif
if(objectp (fc[path])) {
resolv_debug ("handle_import(%O, %O) => found %O (cached)\n",
what, current_file, fc[path]);
return fc[path];
}
resolv_debug ("handle_import(%O, %O) => new dirnode\n", what, current_file);
#ifdef PIKE_MODULE_RELOC
// If we have PIKE_MODULE_RELOC enabled,
// we might need to map to a join node.
// FIXME: Ought to use the non-relocate_module() fakeroot().
if(path == "/${PIKE_MODULE_PATH}" ||
has_prefix(path, "/${PIKE_MODULE_PATH}/")) {
string tmp = path[21..];
array(dirnode) dirnodes = ({});
foreach(pike_module_path, string prefix) {
string s2 = fakeroot(sizeof(tmp)? combine_path(prefix, tmp) : prefix);
if(master_file_stat(s2))
dirnodes += ({ dirnode(s2, handler) });
}
resolv_debug("handle_import(%O, %O) => Found %d dirnodes\n",
what, current_file, sizeof(dirnodes));
if (sizeof(dirnodes) > 1) return fc[path] = joinnode(dirnodes);
if (sizeof(dirnodes)) return fc[path] = dirnodes[0];
return UNDEFINED;
}
#endif /* PIKE_MODULE_RELOC */
return fc[path] = dirnode(fakeroot(path), handler);
}
#endif /* 0 */
multiset no_resolv = (<>);
//! Resolver of symbols not located in the program being compiled.
class CompatResolver
{
//! Join node of the root modules for this resolver.
joinnode root_module =
joinnode(({instantiate_static_modules(predef::_static_modules)}),
0, 0, "predef::");
//! Lookup from handler module to corresponding root_module.
mapping(object:joinnode) handler_root_modules = ([]);
//! The pike system module path, not including any set by the user.
array(string) system_module_path=({});
//! The complete module search path
array(string) pike_module_path=({});
//! The complete include search path
array(string) pike_include_path=({});
//! The complete program search path
array(string) pike_program_path=({});
mapping(string:string) predefines = master()->initial_predefines;
string ver;
//! If we fail to resolv, try the fallback.
//!
//! Typical configuration:
//! @pre{0.6->7.0->7.2-> ... ->master@}
CompatResolver fallback_resolver;
//! The CompatResolver is initialized with a value that can be
//! casted into a "%d.%d" string, e.g. a version object.
//!
//! It can also optionally be initialized with a fallback resolver.
protected void create(mixed version, CompatResolver|void fallback_resolver)
{
resolv_debug("CompatResolver(%O, %O)\n", version, fallback_resolver);
ver=(string)version;
#if 0
if (version) {
root_module->symbol = ver + "::";
}
#endif
if (CompatResolver::fallback_resolver = fallback_resolver) {
root_module->fallback_module = fallback_resolver->root_module;
}
predefines = initial_predefines;
}
//! Add a directory to search for include files.
//!
//! This is the same as the command line option @tt{-I@}.
//!
//! @note
//! Note that the added directory will only be searched when using
//! < > to quote the included file.
//!
//! @seealso
//! @[remove_include_path()]
//!
void add_include_path(string tmp)
{
tmp=normalize_path(combine_path_with_cwd(tmp));
pike_include_path-=({tmp});
pike_include_path=({tmp})+pike_include_path;
}
//! Remove a directory to search for include files.
//!
//! This function performs the reverse operation of @[add_include_path()].
//!
//! @seealso
//! @[add_include_path()]
//!
void remove_include_path(string tmp)
{
tmp=normalize_path(combine_path_with_cwd(tmp));
pike_include_path-=({tmp});
}
//! Add a directory to search for modules.
//!
//! This is the same as the command line option @tt{-M@}.
//!
//! @seealso
//! @[remove_module_path()]
//!
void add_module_path(string tmp)
{
tmp=normalize_path(combine_path_with_cwd(tmp));
root_module->add_path(tmp);
pike_module_path = ({ tmp }) + (pike_module_path - ({ tmp }));
}
//! Remove a directory to search for modules.
//!
//! This function performs the reverse operation of @[add_module_path()].
//!
//! @seealso
//! @[add_module_path()]
//!
void remove_module_path(string tmp)
{
tmp=normalize_path(combine_path_with_cwd(tmp));
root_module->rem_path(tmp);
pike_module_path -= ({ tmp });
}
//! Add a directory to search for programs.
//!
//! This is the same as the command line option @tt{-P@}.
//!
//! @seealso
//! @[remove_program_path()]
//!
void add_program_path(string tmp)
{
tmp=normalize_path(combine_path_with_cwd(tmp));
pike_program_path-=({tmp});
pike_program_path=({tmp})+pike_program_path;
}
//! Remove a directory to search for programs.
//!
//! This function performs the reverse operation of @[add_program_path()].
//!
//! @seealso
//! @[add_program_path()]
//!
void remove_program_path(string tmp)
{
tmp=normalize_path(combine_path_with_cwd(tmp));
pike_program_path-=({tmp});
}
//! Add a define (without arguments) which will be implicitly
//! defined in @[cpp] calls.
void add_predefine (string name, mixed value)
{
predefines[name] = value;
}
//! Remove a define from the set that are implicitly defined in
//! @[cpp] calls.
void remove_predefine (string name)
{
m_delete (predefines, name);
}
//! Returns a mapping with the current predefines.
mapping get_predefines()
{
return predefines;
}
string evaluate_define(string def, string arguments)
{
mixed val = arguments ? predefines[def+"()"] : predefines[def];
if( callablep(val) )
{
object C = resolv("Parser.C");
array args;
if( arguments )
args = map(
map(C.group(C.split(arguments))/({","}),C.simple_reconstitute),
Builtin.string_trim_all_whites);
else
args = ({});
val = val( @args );
}
return (string)val;
}
//! Instantiate static modules in the same way that dynamic modules
//! are instantiated.
protected mapping(string:mixed) instantiate_static_modules(object|mapping static_modules)
{
mapping(string:mixed) res = ([]), joins = ([]);
foreach(indices(static_modules), string name) {
mixed val = static_modules[name];
if (!val->_module_value)
val = val();
if(mixed tmp=val->_module_value) val=tmp;
if(!has_value(name, '.'))
res[name] = val;
else {
mapping(string:mixed) level = joins;
string pfx;
while(2 == sscanf(name, "%s.%s", pfx, name))
level = (level[pfx] || (level[pfx] = ([])));
level[name] = val;
}
}
joinnode joinify(mapping m)
{
foreach(m; string n; mixed v)
if(mappingp(v))
m[n]=joinify(v);
return joinnode(({m}));
};
foreach(joins; string n; mixed v) {
if(mappingp(v))
v = joinify(v);
if(res[n])
res[n] = joinnode(({res[n], v}), 0, 0, n);
else
res[n] = v;
}
return res;
}
//!
mapping get_default_module()
{
resolv_debug ("%O->get_default_module()\n", this);
/* This is an ugly kluge to avoid an infinite recursion.
* The infinite recursion occurs because this function is
* called for every file when the compat_major/minor is set.
* This kluge could cause problems with threads if the
* compiler was threaded. -Hubbe
*/
int saved_compat_minor=compat_minor;
int saved_compat_major=compat_major;
compat_minor=-1;
compat_major=-1;
mixed x;
mixed err =catch {
if(resolv("__default") && (x=resolv("__default.all_constants")))
x=x();
};
compat_major=saved_compat_major;
compat_minor=saved_compat_minor;
if(err) throw(err);
return x;
}
// _static_modules -- default for global::
// current_handler->get_default_module()->_static_modules
joinnode get_root_module(object|void current_handler)
{
if (!root_module) {
error("get_root_module(%O): No default root module!\n",
current_handler);
}
if (!current_handler) return root_module;
joinnode node = handler_root_modules[current_handler];
if (node) return node;
// Check for _static_modules.
mixed static_modules = _static_modules;
if (current_handler->get_default_module) {
mapping(string:mixed) default_module =
current_handler->get_default_module();
if (default_module) {
static_modules = default_module["_static_modules"] || ([]);
}
}
node = joinnode(({ instantiate_static_modules(static_modules),
// Copy relevant stuff from the root module.
@filter(root_module->joined_modules,
lambda(mixed x) {
return objectp(x) &&
object_program(x)->is_resolv_dirnode;
}) }),
current_handler,
root_module->fallback_module,
"predef::");
// FIXME: Is this needed?
// Kluge to get _static_modules to work at top level.
node->cache->_static_modules = static_modules;
return node;
}
//!
mixed resolv_base(string identifier, string|void current_file,
object|void current_handler)
{
// werror("Resolv_base(%O)\n",identifier);
return get_root_module(current_handler)[identifier];
}
//! Same as @[resolv], but throws an error instead of returning
//! @[UNDEFINED] if the resolv failed.
mixed resolv_or_error(string identifier, string|void current_file,
void|object current_handler)
{
mixed res = resolv(identifier, current_file, current_handler);
if(undefinedp(res)) error("Could not resolve %s.\n", identifier);
return res;
}
//!
mixed resolv(string identifier, string|void current_file,
object|void current_handler)
{
resolv_debug("resolv(%O, %O)\n",identifier, current_file);
INC_RESOLV_MSG_DEPTH();
// FIXME: Support having the cache in the handler?
if( no_resolv[ identifier ] ) {
DEC_RESOLV_MSG_DEPTH();
resolv_debug("resolv(%O, %O) => excluded\n",identifier, current_file);
return UNDEFINED;
}
if (current_file && !stringp(current_file)) {
error("resolv(%O, %O, %O): current_file is not a string!\n",
identifier, current_file, current_handler);
}
array(string) tmp = identifier/"::";
mixed ret;
if (sizeof(tmp) > 1) {
string scope = tmp[0];
tmp = tmp[1]/".";
switch(scope) {
case "predef":
ret = all_constants();
break;
default:
if (sscanf(scope, "%d.%d%*s", int major, int minor) == 3) {
// Versioned identifier.
ret = get_compilation_handler(major, minor);
if (ret) {
mixed mod = ret->get_default_module();
if (!undefinedp(mod = mod[tmp[0]])) {
ret = mod;
} else {
ret = ret->resolv(tmp[0]);
}
tmp = tmp[1..];
break;
}
}
error("resolv(%O, %O, %O): Unsupported scope: %O!\n",
identifier, current_file, current_handler, scope);
}
} else {
tmp = identifier/".";
ret = resolv_base(tmp[0], current_file, current_handler);
tmp = tmp[1..];
}
foreach(tmp,string index) {
resolv_debug("indexing %O with %O...\n",
ret, index);
// NB: Running indices() on directory nodes will force them to load
// all their content, which is probably NOT what you want...
// resolv_debug("indices(%O): %O\n", ret, indices(ret));
if (undefinedp(ret)) break;
ret = ret[index];
}
DEC_RESOLV_MSG_DEPTH();
#ifdef RESOLV_DEBUG
if (undefinedp (ret))
resolv_debug("resolv(%O, %O) => not found\n",identifier, current_file);
else
resolv_debug("resolv(%O, %O) => found %O\n",identifier, current_file, ret);
#endif /* RESOLV_DEBUG */
return ret;
}
//! 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
string handle_include(string f,
string current_file,
int local_include)
{
if(local_include)
{
if(IS_ABSOLUTE_PATH(f)) return combine_path(f);
return combine_path_with_cwd(dirname(current_file), f);
}
else
{
foreach(pike_include_path, string path)
{
path=combine_path(path,f);
if(master_file_stat(fakeroot(path)))
return path;
}
if (fallback_resolver) {
return fallback_resolver->handle_include(f, current_file,
local_include);
}
}
// Failed.
return 0;
}
//!
string read_include(string f)
{
AUTORELOAD_CHECK_FILE(f);
if (array|object err = catch {
return master_read_file (f);
})
compile_cb_rethrow (err);
}
protected string _sprintf(int t)
{
return t=='O' && sprintf("CompatResolver(%O)",ver);
}
}
inherit CompatResolver;
//! 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;
// Gets set to 1 if we're in async-mode (script->main() returned <0)
private int(0..1) _async=0;
//! Returns 1 if we´re in async-mode, e.g. if the main method has
//! returned a negative number.
int(0..1) asyncp() {
return _async;
}
#if constant(thread_create)
// this must be done in __init if someone inherits the master
protected object _backend_thread=this_thread();
//! The backend_thread() function is useful to determine if you are
//! the backend thread - important when doing async/sync protocols.
//! This method is only available if thread_create is present.
object backend_thread()
{
return _backend_thread;
}
#endif
mapping(string:string) initial_predefines = ([]);
protected mixed main_resolv(string sym, CompatResolver|void resolver) {
mixed v = (resolver||this)->resolv(sym);
if(!v)
error("Could not resolve %s. "
"(Perhaps the installed pike tree has been moved.)\n", sym);
return v;
};
//! 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.
void _main(array(string(0..255)) orig_argv)
{
array(string) argv=copy_value(orig_argv);
int debug,trace,run_tool;
object tmp;
string postparseaction=0;
predefines = initial_predefines =
Builtin._take_over_initial_predefines();
_pike_file_name = orig_argv[0];
_master_file_name = __FILE__;
#if constant(thread_create)
_backend_thread = this_thread();
#endif
#ifndef NOT_INSTALLED
{
array parts = (getenv("PIKE_INCLUDE_PATH")||"")/PATH_SEPARATOR-({""});
int i = sizeof(parts);
while(i) add_include_path(parts[--i]);
parts = (getenv("PIKE_PROGRAM_PATH")||"")/PATH_SEPARATOR-({""});
i = sizeof(parts);
while(i) add_program_path(parts[--i]);
parts = (getenv("PIKE_MODULE_PATH")||"")/PATH_SEPARATOR-({""});
i = sizeof(parts);
while(i) add_module_path(parts[--i]);
}
#endif
// Some configure scripts depends on this format.
string format_paths() {
return ("master.pike...: " + (_master_file_name || __FILE__) + "\n"
"Module path...: " + pike_module_path*"\n"
" " + "\n"
"Include path..: " + pike_include_path*"\n"
" " + "\n"
"Program path..: " + pike_program_path*"\n"
" " + "\n");
};
Version cur_compat_ver;
if(sizeof(argv)>1 && sizeof(argv[1]) && argv[1][0]=='-')
{
array q;
tmp = main_resolv( "Getopt" );
int NO_ARG = tmp->NO_ARG;
int MAY_HAVE_ARG = tmp->MAY_HAVE_ARG;
int HAS_ARG = tmp->HAS_ARG;
q=tmp->find_all_options(argv,({
({"compat_version", HAS_ARG, ({"-V", "--compat"}), 0, 0}),
({"version", NO_ARG, ({"-v", "--version"}), 0, 0}),
({"dumpversion", NO_ARG, ({"--dumpversion"}), 0, 0}),
({"help", MAY_HAVE_ARG, ({"-h", "--help"}), 0, 0}),
({"features", NO_ARG, ({"--features"}), 0, 0}),
({"info", NO_ARG, ({"--info"}), 0, 0}),
({"execute", HAS_ARG, ({"-e", "--execute"}), 0, 0}),
({"debug_without", HAS_ARG, ({"--debug-without"}), 0, 0}),
({"preprocess", HAS_ARG, ({"-E", "--preprocess"}), 0, 0}),
({"modpath", HAS_ARG, ({"-M", "--module-path"}), 0, 0}),
({"ipath", HAS_ARG, ({"-I", "--include-path"}), 0, 0}),
({"ppath", HAS_ARG, ({"-P", "--program-path"}), 0, 0}),
({"showpaths", MAY_HAVE_ARG, ({"--show-paths"}), 0, 0}),
({"warnings", NO_ARG, ({"-w", "--warnings"}), 0, 0}),
({"nowarnings", NO_ARG, ({"-W", "--woff", "--no-warnings"}), 0, 0}),
({"autoreload", NO_ARG, ({"--autoreload"}), 0, 0}),
({"master", HAS_ARG, ({"-m"}), 0, 0}),
({"compiler_trace", NO_ARG, ({"--compiler-trace"}), 0, 0}),
({"assembler_debug",MAY_HAVE_ARG, ({"--assembler-debug"}), 0, 0}),
({"optimizer_debug",MAY_HAVE_ARG, ({"--optimizer-debug"}), 0, 0}),
({"debug", MAY_HAVE_ARG, ({"--debug"}), 0, 1}),
({"trace", MAY_HAVE_ARG, ({"--trace"}), 0, 1}),
({"ignore", MAY_HAVE_ARG, ({"-Dqdatplr"}), 0, 1}),
({"ignore", HAS_ARG, ({"-s"}), 0, 0}),
({"run_tool", NO_ARG, ({"-x"}), 0, 0}),
({"show_cpp_warn", NO_ARG, ({"--show-all-cpp-warnings","--picky-cpp"}), 0, 0}),
}), 1);
/* Parse -M and -I backwards */
for(int i=sizeof(q)-1; i>=0; i--)
{
switch(q[i][0])
{
case "compat_version":
sscanf(q[i][1],"%d.%d",compat_major,compat_minor);
break;
#ifdef PIKE_AUTORELOAD
case "autoreload":
autoreload_on++;
break;
#endif
case "debug_without":
// FIXME: Disable loading of dumped modules?
foreach( q[i][1]/",", string feature )
{
switch( feature )
{
case "ttf":
no_resolv[ "_Image_TTF" ] = 1;
break;
case "zlib":
no_resolv[ "Gz" ] = 1;
break;
case "unisys":
no_resolv[ "_Image_GIF" ] = 1;
no_resolv[ "_Image_TIFF" ] = 1;
break;
case "threads":
// not really 100% correct, but good enough for most things.
no_resolv[ "Thread" ] = 1;
add_constant( "thread_create" );
break;
default:
no_resolv[ feature ] = 1;
break;
}
}
break;
case "debug":
debug+=(int)q[i][1];
break;
#if constant(_compiler_trace)
case "compiler_trace":
_compiler_trace(1);
break;
#endif /* constant(_compiler_trace) */
#if constant(_assembler_debug)
case "assembler_debug":
_assembler_debug((int)q[i][1]);
break;
#endif /* constant(_assembler_debug) */
#if constant(_optimizer_debug)
case "optimizer_debug":
_optimizer_debug((int)q[i][1]);
break;
#endif /* constant(_optimizer_debug) */
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 "nowarnings":
want_warnings--;
break;
case "master":
_master_file_name = q[i][1];
break;
case "run_tool":
run_tool = 1;
break;
case "show_cpp_warn":
show_if_constant_errors = 1;
break;
}
}
cur_compat_ver = Version (compat_major, compat_minor);
if (cur_compat_ver < lowestcompat)
{
werror("This Pike only supports compatibility down to %s.\n",
(string)lowestcompat);
cur_compat_ver = lowestcompat;
compat_major = lowestcompat->major;
compat_minor = lowestcompat->minor;
}
if (compat_major != -1) {
object compat_master = get_compat_master (compat_major, compat_minor);
if (cur_compat_ver <= Version (7, 6)) {
mapping(string:array(string)) compat_env = ([]);
foreach (Builtin._getenv(); string var; string val) {
#ifdef __NT__
compat_env[lower_case (var)] = ({var, val});
#else
compat_env[var] = ({var, val});
#endif
}
compat_master->environment = compat_env;
}
}
foreach(q, array opts)
{
switch(opts[0])
{
case "dumpversion":
write("%d.%d.%d\n", __REAL_MAJOR__, __REAL_MINOR__, __REAL_BUILD__);
exit(0);
case "version":
exit(0, string_to_utf8(version() + " Copyright © 1994-2018 Linköping University\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 COPYRIGHT in the Pike distribution for more details.\n"));
case "help":
exit( 0, main_resolv("Tools.MasterHelp")->do_help(opts[1]) );
case "features":
postparseaction="features";
break;
case "info":
postparseaction="info";
break;
case "showpaths":
if( stringp(opts[1]) )
{
switch(opts[1])
{
case "master":
write( (_master_file_name || __FILE__)+"\n" );
break;
case "module":
write( (pike_module_path * ":")+"\n" );
break;
case "include":
write( (pike_include_path * ":")+"\n" );
break;
case "program":
write( (pike_program_path * ":")+"\n" );
break;
default:
exit(1, "Unknown path type %s\n", opts[1]);
}
exit(0);
}
exit(0, format_paths());
case "execute":
main_resolv( "Gmp.bignum" );
random_seed((time() ^ (getpid()<<8)));
argv = tmp->get_args(argv,1);
program prog;
mixed compile_err = catch {;
if (intp (opts[1]))
prog = compile_string ("mixed run() {}");
else {
string code = opts[1];
while(sscanf(code, "%sCHAR(%1s)%s", code, string c, string rest)==3)
code += c[0] + rest;
if (cur_compat_ver <= Version (7, 6))
prog = compile_string(
"#define NOT(X) !(X)\n"
"mixed run(int argc, array(string) argv,"
"mapping(string:string) env){"+
code+";}");
else
prog = compile_string(
"#define NOT(X) !(X)\n"
"mixed run(int argc, array(string) argv){" + code + ";}");
}
};
if (compile_err) {
if (compile_err->is_cpp_or_compilation_error) {
// Don't clutter the output with the backtrace for
// compilation errors.
exit (20, call_describe_error (compile_err));
}
else throw (compile_err);
}
#if constant(_debug)
if(debug) _debug(debug);
#endif
if(trace) trace = predef::trace(trace);
mixed ret;
mixed err = catch {
// One reason for this catch is to get a new call to
// eval_instruction in interpret.c so that the debug and
// trace levels set above take effect in the bytecode
// evaluator.
if (cur_compat_ver <= Version (7, 6))
ret = prog()->run(sizeof(argv),argv,getenv());
else
ret = prog()->run(sizeof(argv),argv);
};
predef::trace(trace);
if (err) {
handle_error (err);
ret = 10;
}
if(stringp(ret)) {
write(ret);
if(ret[-1]!='\n') write("\n");
}
if(!intp(ret) || ret<0) ret=0;
exit(ret);
case "preprocess":
main_resolv( "Gmp.bignum" );
write(cpp(master_read_file(opts[1]),opts[1]));
exit(0);
}
}
argv = tmp->get_args(argv,1);
}
else
cur_compat_ver = Version (compat_major, compat_minor);
switch (postparseaction)
{
case "features":
write( main_resolv( "Tools.Install.features" )()*"\n"+"\n" );
exit(0);
case "info":
write("Software......Pike\n"
"Version......."+version()+"\n"
"WWW...........http://pike.lysator.liu.se/\n"
"\n"
"pike binary..."+_pike_file_name+"\n"+
format_paths() + "\n"
"Features......"+
main_resolv( "Tools.Install.features" )()*"\n "+
"\n");
exit(0);
}
main_resolv( "Gmp.bignum" );
random_seed(time() ^ (getpid()<<8));
if(sizeof(argv)==1)
{
if(run_tool) {
werror("Pike -x specificed without tool name.\n"
"Available tools:\n");
mapping t = ([]);
int i;
object ts = main_resolv("Tools.Standalone",
get_compilation_handler(compat_major,
compat_minor));
foreach (indices(ts), string s) {
mixed val = ts[s];
if (programp (val)) {
object o = val();
if(!o->main || !o->description) continue;
t[s] = o->description;
i = max(i, sizeof(s));
}
}
foreach(sort(indices(t)), string s)
werror(" %-"+i+"s %s\n", s, t[s]);
exit(1);
}
main_resolv("Tools.Hilfe",
get_compilation_handler(compat_major,
compat_minor))->StdinHilfe();
exit(0);
}
else
argv=argv[1..];
program prog;
if(run_tool) {
mixed err = catch {
prog = main_resolv("Tools.Standalone." + argv[0],
get_compilation_handler(compat_major, compat_minor));
};
if (err)
exit(1, "Pike: Failed to load tool %s:\n"
"%s\n", argv[0],
stringp(err[0])?err[0]:call_describe_backtrace(err));
argv[0] = search(programs, prog) || argv[0];
} else {
argv[0]=combine_path_with_cwd(argv[0]);
mixed err = catch {
prog=(program)argv[0];
};
if (err) {
string fn = argv[0];
if( !file_stat(fn) )
{
if( file_stat(fn+".pike") )
fn += ".pike";
else
exit(1, "Could not find file %O.\n", fn);
}
if( !file_stat(fn)->isreg )
exit(1, "File %O is not a regular file.\n", fn);
if( !master_read_file(fn) )
exit(1, "File %O is not readable. %s.\n",
fn, strerror(errno()));
if (objectp (err) && err->is_cpp_or_compilation_error)
exit(1, "Pike: Failed to compile script.\n");
else
exit(1, "Pike: Failed to compile script:\n"
"%s", call_describe_backtrace(err));
}
// Don't list the program with its real path in the programs
// mapping, so that reverse lookups (typically by the codec)
// always find the canonical "/main" instead.
programs[argv[0]] = no_value;
}
programs["/main"] = prog;
// FIXME: Can this occur at all?
if(!prog)
error("Pike: Couldn't find script to execute\n(%O)\n", argv[0]);
#if constant(_debug)
if(debug) _debug(debug);
#endif
if(trace) trace = predef::trace(trace);
mixed ret;
mixed err = catch {
// The main reason for this catch is actually to get a new call
// to eval_instruction in interpret.c so that the debug and
// trace levels set above take effect in the bytecode evaluator.
// Note that it won't work if there's another catch surrounding
// this one.
object script;
script=prog(argv);
if(!script->main)
error("Error: %s has no main().\n", argv[0]);
if (cur_compat_ver <= Version (7, 6))
ret=script->main(sizeof(argv),argv,getenv());
else if (cur_compat_ver <= Version (8, 0))
ret = script->main(sizeof(argv),argv);
else
{
mixed first_arg = __get_first_arg_type(_typeof(script->main));
// NB: first_arg may be zero eg in case main() ignores all args.
if( first_arg && (typeof(argv) <= first_arg) ) {
// argv accepted as first argument.
ret=script->main(argv);
} else
ret=script->main(sizeof(argv),argv);
}
};
// Disable tracing.
trace = predef::trace(trace);
if (err) {
handle_error (err);
ret = 10;
}
if(!intp(ret))
exit(10, "Error: Non-integer value %O returned from main.\n", ret);
if(ret >=0) exit([int]ret);
_async=1;
// Reenable tracing.
trace = predef::trace(trace);
while(1)
{
mixed err=catch
{
while(1)
Builtin.__backend(3600.0);
};
master()->handle_error(err);
}
}
#if constant(thread_local)
object inhibit_compile_errors = thread_local();
//! Set the compile error, warning and exception behaviour.
//!
//! @param behaviour
//! The desired behaviour. One of:
//! @mixed
//! @type int(0..0)
//! Output compilation errors and warnings to @tt{stderr@}.
//! This is the default behaviour.
//! @type int(1..1)
//! Inhibit output of compilator diagnostics.
//! @type function(string, int, string:void)
//! Function to call for compilation errors. Compilation
//! warnings and exceptions are inhibited.
//!
//! The function will be called with the same arguments
//! as those passed to @[compile_error()].
//! @type CompilationHandler
//! Compilation handler to use for diagnostics.
//! @endmixed
//!
//! @note
//! Note that the behaviour is thread local, and is not copied
//! to new threads when they are created.
//!
//! @seealso
//! @[get_inhibit_compile_errors()]
void set_inhibit_compile_errors(mixed behaviour)
{
inhibit_compile_errors->set(behaviour);
}
//! Get the current compile error, warning and exception behaviour.
//!
//! See @[set_inhibit_compile_errors()] for details.
//!
//! @seealso
//! @[set_inhibit_compile_errors()]
mixed get_inhibit_compile_errors()
{
return inhibit_compile_errors->get();
}
#else /* !constant(thread_local) */
mixed inhibit_compile_errors;
void set_inhibit_compile_errors(mixed f)
{
inhibit_compile_errors=f;
}
mixed get_inhibit_compile_errors()
{
return inhibit_compile_errors;
}
#endif /* constant(thread_local) */
protected private function(string:string) _trim_file_name_cb=0;
string trim_file_name(string s)
{
#ifdef PIKE_MODULE_RELOC
s = relocate_module(s);
#endif
if(getenv("LONG_PIKE_ERRORS")) return s;
if(getenv("SHORT_PIKE_ERRORS")) return BASENAME(s);
if (_trim_file_name_cb) return _trim_file_name_cb(s);
/* getcwd() can fail, but since this is called from handle_error(),
* we don't want to fail, so we don't care about that.
*/
catch {
string cwd=getcwd();
if (sizeof(cwd) && (cwd[-1] != '/')) {
cwd += "/";
}
if(has_prefix (s, cwd)) return s[sizeof(cwd)..];
};
return s;
}
function(string:string) set_trim_file_name_callback(function(string:string) s)
{
function(string:string) f=_trim_file_name_cb;
_trim_file_name_cb=s;
return f;
}
//! This function is called whenever a compile error occurs. @[line]
//! is zero for errors that aren't associated with any specific line.
//! @[err] is not newline terminated.
//!
//! @seealso
//! @[compile_warning()], @[compile_exception()],
//! @[get_inhibit_compile_errors()], @[set_inhibit_compile_errors()],
void compile_error(string file,int line,string err)
{
mixed val;
if(! (val = get_inhibit_compile_errors() ))
{
werror( "%s:%s:%s\n",trim_file_name(file),
line?(string)line:"-",narrowify_string(err) );
}
else if(objectp(val) ||
programp(val) ||
functionp(val))
{
if (objectp(val) && val->compile_error) {
val->compile_error(file, line, err);
} else if (callablep(val)) {
val(file, line, err);
}
}
}
//! This function is called whenever a compile warning occurs. @[line]
//! is zero for warnings that aren't associated with any specific
//! line. @[err] is not newline terminated.
//!
//! @seealso
//! @[compile_error()], @[compile_exception()],
//! @[get_inhibit_compile_errors()], @[set_inhibit_compile_errors()],
void compile_warning(string file,int line,string err)
{
mixed val;
if(!(val = get_inhibit_compile_errors() ))
{
if(want_warnings)
werror( "%s:%s: Warning: %s\n",trim_file_name(file),
line?(string)line:"-",narrowify_string(err) );
}
else if (objectp(val) && val->compile_warning) {
([function(string,int,string:void)]([object]val)
->compile_warning)(file, line, err);
}
}
//! This function is called when an exception is caught during
//! compilation. Its message is also reported to @[compile_error] if
//! this function returns zero.
//!
//! @seealso
//! @[compile_error()], @[compile_warning()],
//! @[get_inhibit_compile_errors()], @[set_inhibit_compile_errors()],
int compile_exception (array|object trace)
{
if (objectp (trace) && ([object]trace)->is_cpp_or_compilation_error)
// Errors thrown by cpp(), compile() or a compile callback should
// be reported as a normal compile error, so let the caller do
// just that.
return 0;
if (mixed val = get_inhibit_compile_errors()) {
if (objectp(val) && ([object]val)->compile_exception)
return ([function(object:int)]([object]val)
->compile_exception)([object]trace);
}
else {
handle_error (trace);
return 1;
}
return 0;
}
//! Called for every runtime warning. The first argument identifies
//! where the warning comes from, the second identifies the specific
//! message, and the rest depends on that. See code below for currently
//! implemented warnings.
void runtime_warning (string where, string what, mixed... args)
{
if (want_warnings)
switch (where + "." + what) {
case "gc.bad_cycle":
// args[0] is an array containing the objects in the cycle
// which aren't destructed and have destroy() functions.
#if 0
// Ignore this warning for now since we do not yet have a weak
// modifier, so it can't be avoided in a reasonable way.
werror ("GC warning: Garbing cycle where destroy() will be called "
"in arbitrary order:\n%{ %s\n%}",
sprintf("%O", args[0][*]));
#endif
break;
default:
werror ("%s warning: %s %O\n", capitalize (where), what, args);
}
}
protected object Charset;
//! This function is called by cpp() when it wants to do
//! character code conversion.
string decode_charset(string data, string charset)
{
if (!Charset) {
Charset = [object]resolv("Charset");
if (!Charset)
compile_cb_error("Cannot handle charset - no Charset module found.");
}
if (mixed err = catch {
object decoder = ([function(string:object)]Charset.decoder)(charset);
return ([function(void:string)]([function(string:object)]decoder->
feed)(data)->drain)();
})
compile_cb_rethrow (err);
}
class Describer
{
int clipped=0;
int canclip=0;
mapping(mixed:int|string) ident = ([]);
int identcount = 0;
void identify_parts (mixed stuff)
{
// Use an array as stack here instead of recursing directly; we
// might be pressed for stack space if the backtrace being
// described is a stack overflow.
array identify_stack = ({stuff});
while (sizeof (identify_stack)) {
stuff = identify_stack[-1];
identify_stack = identify_stack[..<1];
if (!intp(ident[stuff])) continue; // Already identified.
if (objectp (stuff) || functionp (stuff) || programp (stuff))
ident[stuff]++;
else if (arrayp (stuff)) {
if (!ident[stuff]++)
identify_stack += stuff;
}
else if (multisetp (stuff)) {
if (!ident[stuff]++)
identify_stack += indices([multiset]stuff);
}
else if (mappingp (stuff)) {
if (!ident[stuff]++)
identify_stack += indices([mapping]stuff) + values([mapping]stuff);
}
}
}
string describe_string (string m, int maxlen)
{
canclip++;
if(sizeof(m) < maxlen)
{
string t = sprintf("%q", m);
if (sizeof(t) < (maxlen + 2))
return t;
t = 0;
}
clipped++;
if(maxlen>10) {
int h = (3*maxlen)/4;
return sprintf("%q+[%d]+%q",
m[..h-5],
sizeof(m)-(maxlen-8),
m[sizeof(m) - (maxlen - (h + 4))..]);
}
return "string["+sizeof(m)+"]";
}
string describe_array (array m, int maxlen)
{
if(!sizeof(m)) return "({})";
else {
if(maxlen<5)
{
clipped++;
return "array["+sizeof(m)+"]";
}
else {
canclip++;
return "({" + describe_comma_list(m,maxlen-2) +"})";
}
}
}
string describe_mapping (mapping m, int maxlen)
{
if(!sizeof(m)) return "([])";
else return "mapping["+sizeof(m)+"]";
}
string describe_multiset (multiset m, int maxlen)
{
if(!sizeof(m)) return "(<>)";
else return "multiset["+sizeof(m)+"]";
}
string describe (mixed m, int maxlen)
{
catch {
if (stringp (ident[m])) return [string]ident[m];
else if (intp (ident[m]) && ident[m] > 1)
ident[m] = "@" + identcount++;
};
string res;
if (catch (res=sprintf("%t",m)))
res = "object"; // Object with a broken _sprintf(), probably.
switch(res)
{
case "int":
if (!m && undefinedp (m) == 1)
return "UNDEFINED";
case "float":
return (string)m;
case "string":
return describe_string ([string]m, maxlen);
case "array":
res = describe_array ([array]m, maxlen);
break;
case "mapping":
res = describe_mapping ([mapping]m, maxlen);
break;
case "multiset":
res = describe_multiset ([multiset]m, maxlen);
break;
case "function":
if (string tmp=describe_function([function]m)) res = tmp;
break;
case "program":
if(string tmp=describe_program([program]m)) res = tmp;
break;
default:
/* object or type. */
if (catch {
if(string tmp=sprintf("%O", m)) res = tmp;
}) {
// Extra paranoia case.
res = sprintf("Instance of %O", _typeof(m));
}
break;
}
// Objects may have _sprintfs that output wide characters,
// and function names may be wide, etc...
res = narrowify_string(res);
if (stringp(ident[m]))
return ident[m] + "=" + res;
return res;
}
string 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;
int done=0;
while(1)
{
array(string) z=allocate(clip);
array(int) isclipped=allocate(clip);
array(int) clippable=allocate(clip);
for(int e=0;e=0)
{
clipped++;
ret+=",,,"+tmp;
}
canclip++;
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=last_newlen || isclipped[e]) && clippable[e])
num_large++;
else
smallsize+=sizeof(z[e]);
if(num_large * 15 + smallsize < maxlen) clipsuggest=e+1;
}
newlen=num_large ? (maxlen-smallsize)/num_large : 0;
if(newlen<8 || newlen >= last_newlen) break;
last_newlen=newlen;
}
if(newlen < 8 && clip)
{
clip-= (clip/4) || 1;
if(clip > clipsuggest) clip=clipsuggest;
}else{
len=newlen;
done++;
break;
}
}
}
return ret;
}
}
string program_path_to_name ( string path,
void|string module_prefix,
void|string module_suffix,
void|string object_suffix )
//! Converts a module path on the form @expr{"Foo.pmod/Bar.pmod"@} or
//! @expr{"/path/to/pike/lib/modules/Foo.pmod/Bar.pmod"@} to a module
//! identifier on the form @expr{"Foo.Bar"@}.
//!
//! If @[module_prefix] or @[module_suffix] are given, they are
//! prepended and appended, respectively, to the returned string if
//! it's a module file (i.e. ends with @expr{".pmod"@} or
//! @expr{".so"@}). If @[object_suffix] is given, it's appended to the
//! returned string if it's an object file (i.e. ends with
//! @expr{".pike"@}).
{
if (path == "/master") return "master" + (object_suffix || "");
array(string) sort_paths_by_length(array(string) paths)
{
sort(map(paths, sizeof), paths);
return reverse(paths);
};
string prefix = "";
array(Version) versions = reverse(sort(indices(compat_handler_cache)));
find_prefix:
foreach(versions, Version version) {
CompatResolver r = compat_handler_cache[version];
if (!r) continue; // Protection against the gc...
foreach(sort_paths_by_length(map(r->pike_module_path - ({""}),
lambda(string s) {
if (s[-1] == '/') return s;
return s+"/";
})),
string path_prefix) {
if (has_prefix(path, path_prefix)) {
path = path[sizeof(path_prefix)..];
if (version != currentversion) {
prefix = ((string)version) + "::";
}
break find_prefix;
}
}
}
#if 0
// This seems broken. Why should the current directory or the
// setting of SHORT_PIKE_ERRORS etc affect the module identifiers?
// /mast
path = trim_file_name(path);
#endif
string modname = replace(path, ".pmod/", ".");
if(search(modname, "/")<0) path=modname;
path = prefix + path;
if (has_suffix(path, ".module.pmod")) {
return (module_prefix || "") + path[..<12] + (module_suffix || "");
}
if (has_suffix(path, ".pmod")) {
return (module_prefix || "") + path[..<5] + (module_suffix || "");
}
if (has_suffix(path, ".so")) {
return (module_prefix || "") + path[..<3] + (module_suffix || "");
}
if (has_suffix(path, ".pike")) {
return path[..<5] + (object_suffix || "");
}
return path + (object_suffix || "");
}
//! Describe the path to the module @[mod].
//!
//! @param mod
//! If @[mod] is a program, attempt to describe the path
//! to a clone of @[mod].
//!
//! @param ret_obj
//! If an instance of @[mod] is found, it will be returned
//! by changing element @expr{0@} of @[ret_obj].
//!
//! @returns
//! The a description of the path.
//!
//! @note
//! The returned description will end with a proper indexing method
//! currently either @expr{"."@} or @expr{"->"@}.
string describe_module(object|program mod, array(object)|void ret_obj)
{
// Note: mod might be a bignum object; objectp won't work right for
// our purposes. object_program returns zero for non-objects, so we
// use it instead.
program parent_fun = object_program(mod);
if (parent_fun) {
if (ret_obj) ret_obj[0] = mod;
} else if (programp (mod)) {
parent_fun = mod;
// When running with debug we might be called before __INIT, so
// we have to check if objects exists before we use it.
if (objects && objectp (mod = objects[parent_fun]) && ret_obj)
ret_obj[0] = mod;
}
else
return ""; // efun
if (mod) {
catch {
string res = sprintf("%O", mod);
if (res != "object" && res != "")
return (objectp (objects[parent_fun]) && programs["/master"] != parent_fun?
res+".":res+"->");
};
string res = search(all_constants(), mod);
if (res) return res;
}
if (!object_program(parent_fun)) {
// We might be a top-level entity.
if (string path = programs_reverse_lookup (parent_fun))
return program_path_to_name(path, "", ".", "()->");
}
// Begin by describing our parent.
array(object) parent_obj = ({ 0 });
string res = describe_module(function_object(parent_fun)||
function_program(parent_fun)||
object_program(parent_fun),
parent_obj);
// werror("So far: %O parent_obj:%O\n", res, parent_obj);
object|program parent =
object_program (parent_obj[0]) ? parent_obj[0] : object_program(parent_fun);
if (mod && (object_program (parent) || parent)) {
// Object identified.
catch {
// Check if we're an object in parent.
int i = search(values(parent), mod);
if (i >= 0) {
return res + [string]indices(parent)[i] + ".";
}
};
}
// We're cloned from something in parent.
if (string fun_name = function_name(parent_fun)) {
return res + fun_name + "()->";
}
// No such luck.
// Try identifying a clone of ourselves.
if (!mod && (object_program (parent) || parent)) {
catch {
// Check if there's a clone of parent_fun in parent_obj.
int i;
array(mixed) val = values(parent);
array(string) ind = [array(string)]indices(parent);
for (i=0; i < sizeof(val); i++) {
if (object_program(val[i]) && object_program(val[i]) == parent_fun) {
return res + ind[i] + ".";
}
}
};
}
// We're really out of luck here...
return res + (describe_program(parent_fun)||"unknown_program") + "()->";
}
//!
string describe_object(object o)
{
string s;
if(undefinedp (o)) return 0; // Destructed.
// Handled by the search of all_constants() below.
// if (o == _static_modules) return "_static_modules";
program|function(mixed...:void|object) parent_fun = object_program(o);
/* Constant object? */
catch {
object|program parent_obj =
(function_object(parent_fun) || function_program(parent_fun));
if (objectp (parent_obj) || parent_obj) {
/* Check if we have a constant object. */
object tmp = objects[parent_obj];
if (objectp (tmp)) parent_obj = tmp;
/* Try finding ourselves in parent_obj. */
int i = search(values(parent_obj), o);
if (i >= 0) {
s = [string]indices(parent_obj)[i];
return describe_module(parent_obj) + s;
}
}
};
if ((s = search(all_constants(), o))) return s;
// When running with RESOLV_DEBUG this function may
// get called before objects has been initialized.
if(objects && objectp (objects[parent_fun]))
if ((s = programs_reverse_lookup (parent_fun)) &&
(s=program_path_to_name(s, "", "", "()")))
return s;
/* Try identifying the program. */
if(( s=describe_program(parent_fun) ))
return s+"()";
return 0;
}
//!
string describe_program(program|function p)
{
string s;
if(!p) return 0;
if (p == object_program (_static_modules))
return "object_program(_static_modules)";
if(programp(p) &&
(s = programs_reverse_lookup ([program] p)) &&
(s=program_path_to_name(s, "object_program(", ")", "")))
return s;
if(object|program tmp=(function_object(p) || function_program(p))) {
if(s = function_name(p))
{
return describe_module(tmp) + s;
}
}
if(s=Builtin.program_defined(p))
return BASENAME(s);
return search(all_constants(), p);
}
//!
string describe_function (function f)
{
if (!f) return 0;
string name;
if (name = search(all_constants(), f)) return name;
if(string s = programs_reverse_lookup (f))
{
if(has_suffix(s, ".pmod"))
name = BASENAME(s[..<5]);
else
name = trim_file_name(s);
}
else
if (catch (name = function_name (f))) name = "function";
object o = function_object([function(mixed...:void|mixed)]f);
if(object_program (o)) { // Check if it's an object in a way that
// (hopefully) doesn't call any functions
// in it (neither `== nor `!).
if (objects[object_program (o)] == o)
return describe_module (o) + name;
string s;
if (!catch (s = sprintf("%O",o)) && s != "object")
return s+"->"+name;
}
return name;
}
/* 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.
*/
//! @appears describe_backtrace
//! Return a readable message that describes where the backtrace
//! @[trace] was made (by @[backtrace]).
//!
//! It may also be an error object or array (typically caught by a
//! @[catch]), in which case the error message also is included in the
//! description.
//!
//! Pass @[linewidth] -1 to disable wrapping of the output.
//!
//! @seealso
//! @[backtrace()], @[describe_error()], @[catch()], @[throw()]
//!
string describe_backtrace(mixed trace, void|int linewidth)
{
int e;
string ret;
int backtrace_len=((int)getenv("PIKE_BACKTRACE_LEN")) || bt_max_string_len;
if(!linewidth)
{
linewidth=99999;
catch
{
linewidth=[int]Files()->_stdin->tcgetattr()->columns;
};
if(linewidth<10) linewidth=99999;
}
// Note: Partial code duplication in describe_error and get_backtrace.
if (objectp(trace) && ([object]trace)->is_generic_error) {
object err_obj = [object] trace;
if (mixed err = catch {
if (functionp (err_obj->message))
ret = err_obj->message();
else if (undefinedp (ret = err_obj->error_message))
// For compatibility with error objects trying to behave
// like arrays.
ret = err_obj[0];
if (!ret)
ret = "";
else if (!stringp (ret))
ret = sprintf ("\n",
err_obj, ret);
if (functionp (err_obj->backtrace))
trace = err_obj->backtrace();
else if (undefinedp (trace = err_obj->error_backtrace))
// For compatibility with error objects trying to behave
// like arrays.
trace = err_obj[1];
if (!trace)
return ret + "\n";
else if (!arrayp (trace))
return sprintf ("%s\n",
ret, err_obj, trace);
})
return sprintf ("\n",
err_obj, trim_all_whites (call_describe_error (err)));
}
else if (arrayp(trace)) {
if (sizeof([array]trace)==2 && stringp(ret = ([array]trace)[0])) {
trace = ([array] trace)[1];
if(!trace)
return ret + "\n";
else if (!arrayp (trace))
return sprintf ("%s\n",
ret, trace);
}
else
ret = "";
}
else {
#if constant(_gdb_breakpoint)
_gdb_breakpoint();
#endif
return sprintf ("\n"
"%s\n", trace, call_describe_backtrace(backtrace()));
}
{
Describer desc = Describer();
array trace = [array]trace;
int end = 0;
if( (sizeof(trace)>1) &&
arrayp(trace[0]) &&
(sizeof([array]trace[0]) > 2) &&
(([array]trace[0])[2] == _main))
end = 1;
if( end==1 && (sizeof(trace)>2) &&
arrayp(trace[1]) && (sizeof([array]trace[1])>2) &&
(([array]trace[1])[2] == main_resolv) &&
arrayp(trace[-1]) && (sizeof([array]trace[-1])>2) &&
(([array]trace[-1]))[2] == compile_string )
end = sizeof(trace);
mapping(string:int) prev_pos = ([]);
array(string) frames = ({});
int loop_start = 0, loop_next, loops;
for(e = sizeof(trace)-1; e>=end; e--)
{
mixed tmp;
string row;
if (array err=[array]catch {
tmp = trace[e];
if(stringp(tmp))
{
row=[string]tmp;
}
else if(arrayp(tmp))
{
if(sprintf("%t",tmp)=="object") {
// tmp is backtrace_frame
desc->identify_parts( tmp->args );
}
else
desc->identify_parts( tmp );
array tmp = [array]tmp;
string pos;
if(sizeof(tmp)>=2 && stringp(tmp[0])) {
if (intp(tmp[1])) {
pos=trim_file_name([string]tmp[0])+":"+(string)tmp[1];
} else {
pos = sprintf("%s:Bad line %t",
trim_file_name([string]tmp[0]), tmp[1]);
}
}else{
string desc="Unknown program";
if(sizeof(tmp)>=3 && functionp(tmp[2]))
{
catch
{
if(mixed tmp=function_object([function(mixed...:
void|mixed)]tmp[2]))
if(tmp=object_program(tmp))
if(tmp=describe_program([program]tmp))
desc=[string]tmp;
};
}
pos=desc;
}
string data;
if(sizeof(tmp)>=3)
{
if(functionp(tmp[2])|programp(tmp[2])) {
data = describe_function ([function]tmp[2]);
}
else if (stringp(tmp[2])) {
data = [string]tmp[2];
} else
data ="unknown function";
data+="("+
desc->describe_comma_list(tmp[3..], backtrace_len)+
")";
if((linewidth == -1) || (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 = pos;
}
}
else
{
if (tmp) {
if (catch (row = sprintf("%O", tmp)))
row = describe_program(object_program(tmp)) + " with broken _sprintf()";
} else {
row = "Destructed object";
}
}
}) {
row = sprintf("Error indexing backtrace line %d: %s (%O)!", e, err[0], err[1]);
}
int dup_frame;
if (!undefinedp(dup_frame = prev_pos[row])) {
dup_frame -= sizeof(frames);
if (!loop_start) {
loop_start = dup_frame;
loop_next = dup_frame + 1;
loops = 0;
continue;
} else {
int new_loop = 0;
if (!loop_next) loop_next = loop_start, new_loop = 1;
if (dup_frame == loop_next++) {
loops += new_loop;
continue;
}
}
}
prev_pos[row] = sizeof(frames);
if (loop_start) {
array(string) tail;
if (!loop_next) tail = ({}), loops++;
else tail = frames[loop_start + sizeof(frames) ..
loop_next - 1 + sizeof(frames)];
if (loops)
frames += ({sprintf ("... last %d frames above repeated %d times ...\n",
-loop_start, loops)});
frames += tail;
prev_pos = ([]);
loop_start = 0;
}
frames += ({row + "\n"});
}
if (loop_start) {
// Want tail to contain a full loop rather than being empty; it
// looks odd when the repeat message ends the backtrace.
array(string) tail = frames[loop_start + sizeof(frames) ..
loop_next - 1 + sizeof(frames)];
if (loops)
frames += ({sprintf("... last %d frames above repeated %d times ...\n",
-loop_start, loops)});
frames += tail;
}
ret += frames * "";
}
return ret;
}
//! @appears describe_error
//!
//! Return the error message from an error object or array (typically
//! caught by a @[catch]). The type of the error is checked, hence
//! @[err] is declared as @expr{mixed@} and not @expr{object|array@}.
//!
//! If an error message couldn't be obtained, a fallback message
//! describing the failure is returned. No errors due to incorrectness
//! in @[err] are thrown.
//!
//! @seealso
//! @[describe_backtrace()], @[get_backtrace]
//!
string describe_error (mixed /* object|array */ err)
{
mixed msg;
// Note: Partial code duplication in describe_backtrace and get_backtrace.
if (objectp(err) && ([object]err)->is_generic_error) {
object err_obj = [object] err;
if (mixed err = catch {
if (functionp (err_obj->message))
msg = err_obj->message();
else if (undefinedp (msg = err_obj->error_message))
// For compatibility with error objects trying to behave
// like arrays.
msg = err_obj[0];
if (stringp (msg))
return msg;
else if (!msg)
return "\n";
else
return sprintf ("\n",
err_obj, msg);
})
return sprintf ("\n",
err_obj, trim_all_whites (call_describe_error (err)));
}
else if (arrayp(err) && sizeof([array]err)==2 &&
(!(msg = ([array]err)[0]) || stringp (msg)))
return [string] msg || "\n";
else
return sprintf ("\n", err);
}
//! @appears get_backtrace
//!
//! Return the backtrace array from an error object or array
//! (typically caught by a @[catch]), or zero if there is none. Errors
//! are thrown on if there are problems retrieving the backtrace.
//!
//! @seealso
//! @[describe_backtrace()], @[describe_error()]
//!
array get_backtrace (object|array err)
{
array bt;
// Note: Partial code duplication in describe_backtrace and describe_error.
if (objectp(err) && ([object]err)->is_generic_error) {
object err_obj = [object] err;
if (functionp (err_obj->backtrace))
bt = err_obj->backtrace();
else if (undefinedp (bt = err_obj->error_backtrace))
// For compatibility with error objects trying to behave like
// arrays.
bt = err_obj[1];
if (bt && !arrayp (bt))
error ("Backtrace in %O is %t, expected array.\n", err_obj, bt);
}
else if (arrayp(err) && sizeof([array]err)==2 &&
(!(bt = ([array]err)[1]) || arrayp (bt)))
{}
else if (err)
error ("Invalid error container: %O\n", err);
return bt;
}
void thread_quanta_exceeded(object thread, int ns)
{
werror("Thread quanta exceeded for %O (%d ns):\n"
"%s\n",
thread, ns,
describe_backtrace(thread->backtrace()));
}
#ifdef ENCODE_DEBUG
# define ENC_MSG(X...) do werror (X); while (0)
# define ENC_RETURN(val) do { \
mixed _v__ = (val); \
werror (" returned %s\n", \
undefinedp (_v__) ? "UNDEFINED" : \
narrowify_string(sprintf ("%O", _v__))); \
return _v__; \
} while (0)
#else
# define ENC_MSG(X...) do {} while (0)
# define ENC_RETURN(val) do return (val); while (0)
#endif
#ifdef DECODE_DEBUG
# define DEC_MSG(X...) do werror (X); while (0)
# define DEC_RETURN(val) do { \
mixed _v__ = (val); \
werror (" returned %s\n", \
undefinedp (_v__) ? "UNDEFINED" : \
narrowify_string(sprintf ("%O", _v__))); \
return _v__; \
} while (0)
#else
# define DEC_MSG(X...) do {} while (0)
# define DEC_RETURN(val) do return (val); while (0)
#endif
class Encoder
//! @appears Pike.Encoder
//!
//! Codec for use with @[encode_value]. It understands all the
//! standard references to builtin functions, pike modules, and the
//! main program script.
//!
//! The format of the produced identifiers are documented here to
//! allow extension of this class:
//!
//! The produced names are either strings or arrays. The string
//! variant specifies the thing to look up according to the first
//! character:
//!
//! 'c' Look up in all_constants().
//! 's' Look up in _static_modules.
//! 'r' Look up with resolv().
//! 'p' Look up in programs.
//! 'o' Look up in programs, then look up the result in objects.
//! 'f' Look up in fc.
//!
//! In the array format, the first element is a string as above and
//! the rest specify a series of things to do with the result:
//!
//! A string Look up this string in the result.
//! 'm' Get module object in dirnode.
//! 'p' Do object_program(result).
//!
//! All lowercase letters and the symbols ':', '/' and '.' are
//! reserved for internal use in both cases where characters are used
//! above.
{
mixed encoded;
protected mapping(mixed:string) rev_constants = ([]);
protected mapping(mixed:string) rev_static_modules = ([]);
protected array find_index (object|program parent, mixed child,
array(object) module_object,
int|void try)
{
array id;
find_id: {
array inds = indices (parent), vals = values (parent);
int i = search (vals, child);
if (i >= 0 && parent[inds[i]] == child) {
id = ({inds[i]});
ENC_MSG (" found as parent value with index %O\n", id[0]);
}
else {
// Try again with the programs of the objects in parent, since
// it's common that only objects and not their programs are
// accessible in modules.
foreach (vals; i; mixed val)
if (objectp (val) && child == object_program (val) &&
val == parent[inds[i]]) {
if (module_object) {
module_object[0] = val;
id = ({inds[i]});
}
else
id = ({inds[i], 'p'});
ENC_MSG (" found as program of parent value object %O with index %O\n",
val, id[0]);
break find_id;
}
if (try) {
ENC_MSG("Cannot find %O in %O.\n", child, parent);
return UNDEFINED;
}
error ("Cannot find %O in %O.\n", child, parent);
}
}
if (!stringp (id[0])) {
if (try) {
ENC_MSG("Got nonstring index %O for %O in %O.\n", id[0], child, parent);
return UNDEFINED;
}
error ("Got nonstring index %O for %O in %O.\n", id[0], child, parent);
}
return id;
}
protected string|array compare_resolved (string name, mixed what,
mixed resolved,
array(object) module_object)
{
array append;
compare: {
if (resolved == what) {
ENC_MSG (" compare_resolved: %O is %O\n", what, resolved);
/* No need for anything advanced. resolv() does the job. */
return "r" + name;
}
if (objectp (resolved)) {
if (object_program (resolved) == what) {
ENC_MSG (" compare_resolved: %O is program of %O\n", what, resolved);
append = ({'p'});
break compare;
}
if ((object_program(resolved)->is_resolv_joinnode) &&
(sizeof(resolved->joined_modules) == 1)) {
ENC_MSG(" compare_resolved: %O is a single element joinnode.\n",
resolved);
resolved = resolved->joined_modules[0];
}
if (object_program(resolved)->is_resolv_dirnode) {
if (resolved->module == what) {
ENC_MSG (" compare_resolved: %O is dirnode module of %O\n", what, resolved);
append = ({'m'});
resolved = resolved->module;
break compare;
}
else if (object_program (resolved->module) == what) {
ENC_MSG (" compare_resolved: %O is program of dirnode module of %O\n",
what, resolved);
append = ({'m', 'p'});
break compare;
}
else
ENC_MSG (" compare_resolved: %O is different from dirnode module %O\n",
what, resolved->module);
}
#if 0
// This is only safe if the joinnode modules don't conflict,
// and we don't know that.
if (object_program(resolved)->is_resolv_joinnode) {
ENC_MSG (" compare_resolved: searching for %O in joinnode %O\n",
what, resolved);
foreach (resolved->joined_modules, mixed part)
if (string|array name = compare_resolved (name, what, part,
module_object)) {
if (module_object) module_object[0] = resolved;
return name;
}
}
#endif
} else {
ENC_MSG(" compare_resolved: %O is not an object.\n", resolved);
}
ENC_MSG (" compare_resolved: %O is different from %O\n", what, resolved);
return 0;
}
name = "r" + name;
string|array res = name;
if (append)
if (module_object) {
// The caller is going to do subindexing. In both the 'p' and
// 'm' cases it's better to do that from the original
// object/dirnode, so just drop the suffixes.
module_object[0] = resolved;
return res;
}
else
return (arrayp (res) ? res : ({res})) + append;
else
return res;
}
string|array nameof (mixed what, void|array(object) module_object)
//! When @[module_object] is set and the name would end with an
//! @expr{object_program@} step (i.e. @expr{'p'@}), then drop that
//! step so that the name corresponds to the object instead.
//! @expr{@[module_object][0]@} will receive the found object.
{
ENC_MSG ("nameof (%t %O)\n", what, what);
if (what == encoded) {
ENC_MSG (" got the thing to encode - encoding recursively\n");
return UNDEFINED;
}
if (string id = rev_constants[what]) ENC_RETURN (id);
if (string id = rev_static_modules[what]) ENC_RETURN (id);
if (objectp (what)) {
if (object_program(what)->is_resolv_dirnode) {
ENC_MSG (" is a dirnode\n");
string name = program_path_to_name (what->dirname);
if (string|array ref = compare_resolved (name, what, resolv (name),
module_object))
ENC_RETURN (ref);
}
else if (object_program(what)->is_resolv_joinnode) {
ENC_MSG (" is a joinnode\n");
object modules = Builtin.array_iterator (what->joined_modules);
object|mapping value;
check_dirnode:
if (modules && objectp (value = modules->value()) &&
object_program(value)->is_resolv_dirnode) {
string name = program_path_to_name (value->dirname);
modules += 1;
foreach (modules;; value)
if (!objectp (value) || !object_program(value)->is_resolv_dirnode ||
program_path_to_name (value->dirname) != name)
break check_dirnode;
ENC_MSG (" joinnode has consistent name %O\n", name);
if (string|array ref = compare_resolved (name, what, resolv (name),
module_object))
ENC_RETURN (ref);
}
}
else if (what->is_pike_master) {
ENC_MSG (" is a master object\n");
ENC_RETURN ("o/master");
}
program prog;
if ((prog = objects_reverse_lookup (what)))
ENC_MSG (" found program in objects: %O\n", prog);
#if 0
else if ((prog = object_program (what)))
ENC_MSG (" got program of object: %O\n", prog);
#endif
if (prog) {
if (prog == encoded) ENC_RETURN ("o");
if (string path = programs_reverse_lookup (prog)) {
ENC_MSG (" found path in programs: %O\n", path);
string name = program_path_to_name (path);
ENC_MSG (" program name: %O\n", name);
if (string|array ref = compare_resolved (name,
what->_module_value || what,
resolv (name), module_object))
ENC_RETURN (ref);
else {
ENC_MSG (" Warning: Failed to resolve; encoding path\n");
#ifdef PIKE_MODULE_RELOC
ENC_RETURN ("o" + unrelocate_module (path));
#else
ENC_RETURN ("o" + path);
#endif
}
}
if (prog == object_program(_static_modules)) {
ENC_MSG (" got _static_modules.\n");
ENC_RETURN ("c" + "_static_modules");
}
}
if (string path = fc_reverse_lookup (what)) {
ENC_MSG (" found path in fc: %O\n", path);
string name = program_path_to_name (path);
if (string|array ref = compare_resolved (name, what, resolv (name),
module_object))
ENC_RETURN (ref);
else {
ENC_MSG (" Warning: Failed to resolve; encoding path\n");
#ifdef PIKE_MODULE_RELOC
ENC_RETURN ("f" + unrelocate_module (path));
#else
ENC_RETURN ("f" + path);
#endif
}
}
if (what->_encode) {
ENC_MSG (" object got _encode function - encoding recursively\n");
return UNDEFINED;
}
if (function|program prog = object_program (what)) {
ENC_MSG (" got program of object: %O\n", prog);
object|program parent;
if (!(parent = function_object (prog) || function_program (prog))) {
// Check if prog is in a module directory.
if (string path = programs_reverse_lookup (prog)) {
path = combine_path(path, "..");
ENC_MSG (" found parent path in programs: %O\n", path);
parent = fc[path];
}
}
if (parent) {
ENC_MSG (" got parent of program: %O\n", parent);
// We're going to subindex the parent so we ask for the
// module object and not the program. That since we'll
// always be able to do a better job if we base the indexing
// on objects.
array parent_object = ({0});
string|array parent_name = nameof (parent, parent_object);
if (!parent_name) {
ENC_MSG (" inside the thing to encode - encoding recursively\n");
return UNDEFINED;
}
else {
ENC_MSG(" parent has name: %O\n", parent_name);
if (objectp (parent_object[0])) parent = parent_object[0];
array id = find_index (parent, what, module_object);
if ((equal(id, ({"_module_value"}))) ||
(equal(id, ({ "__default" })) && has_suffix(parent_name, "::")))
ENC_RETURN (parent_name);
else
ENC_RETURN ((arrayp (parent_name) ? parent_name : ({parent_name})) + id);
}
}
}
error ("Failed to find name of unencodable object %O.\n", what);
}
if (programp (what) || functionp (what)) {
if (string path = programs_reverse_lookup (what)) {
ENC_MSG (" found path in programs: %O\n", path);
string name = program_path_to_name (path);
if (string|array ref = compare_resolved (name, what, resolv (name),
module_object))
ENC_RETURN (ref);
else {
ENC_MSG (" Warning: Failed to resolve; encoding path\n");
#ifdef PIKE_MODULE_RELOC
ENC_RETURN ("p" + unrelocate_module (path));
#else
ENC_RETURN ("p" + path);
#endif
}
}
if (object|program parent = function_object (what) || function_program (what)) {
ENC_MSG (" got parent: %O\n", parent);
if (!objectp (parent)) {
object parent_obj = objects[parent];
if (objectp (parent_obj)) {
ENC_MSG (" found object for parent program in objects: %O\n", parent_obj);
parent = parent_obj;
}
}
array parent_object = ({0});
string|array parent_name = nameof (parent, parent_object);
if (!parent_name || (parent_name == "o")) {
ENC_MSG (" inside the thing to encode - encoding recursively\n");
return UNDEFINED;
}
else {
ENC_MSG(" parent has name: %O\n", parent_name);
if (objectp (parent_object[0])) parent = parent_object[0];
if (parent["_module_value"] == what &&
objects_reverse_lookup (parent)) {
ENC_MSG (" found as _module_value of parent module\n");
ENC_RETURN (parent_name);
}
else {
string|array id = function_name ([program]what);
if (stringp (id) && parent[id] == what) {
ENC_MSG (" found function name in parent: %O\n", id);
id = ({id});
}
else {
if (stringp(parent_name) &&
has_suffix(parent_name, "::__default") &&
parent->all_constants) {
if (id = find_index(parent->all_constants(), what,
module_object, 1)) {
ENC_MSG(" found in all_constants() for %O: %O\n",
parent, id);
ENC_RETURN(({parent_name[..sizeof(parent_name)-
(1+sizeof("__default"))] + id[0]}) +
id[1..]);
}
}
id = find_index (parent, what, module_object);
}
if (equal (id, ({"_module_value"})))
ENC_RETURN (parent_name);
else
ENC_RETURN ((arrayp (parent_name) ? parent_name : ({parent_name})) + id);
}
}
}
error ("Failed to find name of %t %O.\n", what, what);
}
// FIXME: Should have a reverse mapping of constants in modules;
// it can potentially be large mappings and stuff that we encode
// here. They can go stale too.
ENC_MSG (" encoding recursively\n");
return ([])[0];
}
mixed encode_object(object x)
{
DEC_MSG ("encode_object (%O)\n", x);
if(!x->_encode) {
error ("Cannot encode object %O without _encode function.\n", x);
// return ({});
}
DEC_RETURN (([function]x->_encode)());
}
protected void create (void|mixed encoded)
//! Creates an encoder instance. If @[encoded] is specified, it's
//! encoded instead of being reverse resolved to a name. That's
//! necessary to encode programs.
{
this::encoded = encoded;
foreach (all_constants(); string var; mixed val)
rev_constants[val] = "c" + var;
// FIXME: We don't have any good way to do reverse lookups on
// things that are assigned to module variables. Here we use
// rev_constants only to find the most vital ones.
{
object val_module = resolv ("Val");
foreach (indices (val_module), string var) {
mixed val = val_module[var];
if (!programp (val) && !functionp (val))
// The classes in Val.pmod are irrelevant since the current
// values might come from other implementations. Besides,
// they're covered by the ordinary module lookup code.
rev_constants[val] = "rVal." + var;
}
}
rev_static_modules =
mkmapping (values (_static_modules),
map (indices (_static_modules),
lambda (string name) {return "s" + name;}));
#if 0
// This looks flawed; when the decoder looks it up, it'll get the
// module and not its program. /mast
foreach (rev_static_modules; mixed module; string name) {
if (objectp(module)) {
program p = object_program(module);
if (!rev_static_modules[p]) {
// Some people inherit modules...
rev_static_modules[p] = "s" + name;
}
}
}
#endif
}
}
class Decoder (void|string fname, void|int mkobj, void|object handler)
//! @appears Pike.Decoder
//!
//! Codec for use with @[decode_value]. This is the decoder
//! corresponding to @[Encoder]. See that one for more details.
{
protected int unregistered = 1;
object __register_new_program(program p)
{
DEC_MSG ("__register_new_program (%O)\n", p);
// NB: decode_value() has already locked the compiler, so we
// should not need to lock it here.
if(unregistered && fname)
{
unregistered = 0;
resolv_debug("register %s\n", fname);
programs[fname]=p;
if (mkobj)
DEC_RETURN (objectp (objects[p]) ? objects[p] : (objects[p]=__null_program()));
}
DEC_RETURN (0);
}
protected mixed thingof (string|array what)
{
mixed res;
array sublist;
if (arrayp (what)) sublist = [array]what, what = [array|string]sublist[0];
switch (what[0]) {
case 'c':
if (undefinedp (res = all_constants()[what[1..]]))
error ("Cannot find global constant %O.\n", what[1..]);
break;
case 's':
if (undefinedp (res = _static_modules[what[1..]]))
error ("Cannot find %O in _static_modules.\n", what[1..]);
break;
case 'r':
if (undefinedp (res = resolv ([string]what[1..], fname, handler)))
error ("Cannot resolve %O.\n", what[1..]);
break;
case 'p':
if (!(res = low_cast_to_program ([string]what[1..], fname, handler)))
error ("Cannot find program for %O.\n", what[1..]);
break;
case 'o':
if (!objectp(res = low_cast_to_object([string]what[1..], fname, handler)))
error ("Cannot find object for %O.\n", what[1..]);
break;
case 'f':
if (!objectp (res = findmodule ([string]what[1..], handler)))
error ("Cannot find module for %O.\n", what[1..]);
break;
}
DEC_MSG (" got %O\n", res);
if (sublist) {
mixed subres = res;
for (int i = 1; i < sizeof (sublist); i++) {
mixed op = sublist[i];
if (stringp (op)) {
if (!programp (subres) && !objectp (subres) && !mappingp (subres))
error ("Cannot subindex %O%{[%O]%} since it's a %t.\n",
res, sublist[1..i-1], subres);
if (undefinedp (subres = ([mapping]subres)[op]))
error ("Cannot find %O in %O%{[%O]%}.\n",
op, res, sublist[1..i-1]);
DEC_MSG (" indexed with %O: %O\n", op, subres);
}
else switch (op) {
case 'm':
if (objectp (subres) &&
object_program([object]subres)->is_resolv_joinnode) {
dirnode found;
foreach (([object(joinnode)]subres)->joined_modules,
object|mapping part)
if (objectp (part) &&
object_program(part)->is_resolv_dirnode && part->module) {
if (found)
error ("There are ambiguous module objects in %O.\n",
subres);
else
found = [object(dirnode)]part;
}
if (found) subres = found;
}
if (objectp (subres) &&
object_program([object]subres)->is_resolv_dirnode) {
if (([object]subres)->module) {
subres = ([object]subres)->module;
DEC_MSG (" got dirnode module %O\n", subres);
}
else
error ("Cannot find module object in dirnode %O.\n", subres);
}
else
error ("Cannot get module object in thing that isn't "
"a dirnode or unambiguous joinnode: %O\n", subres);
break;
case 'p':
subres = object_program (subres);
DEC_MSG (" got object_program %O\n", subres);
break;
default:
error ("Unknown sublist operation %O in %O\n", op, what);
}
}
res = subres;
}
return res;
}
object objectof (string|array what)
{
DEC_MSG ("objectof (%O)\n", what);
if (!what) {
// This is necessary for compatibility with 7.2 encoded values:
// If an object was fed to encode_value there and there was no
// codec then a zero would be encoded silently since the failed
// call to nameof was ignored. decode_value would likewise
// silently ignore the failed call objectof(0) and a zero would
// be decoded. Now we supply a fairly capable codec which is
// used by default and we therefore get these objectof(0) calls
// here. So if we throw an error we can't decode values which
// 7.2 would encode and decode without a codec (albeit partly
// incorrectly). So just print a sulky warning and continue.. :P
DEC_MSG ("Warning: Decoded broken object identifier to zero.\n");
DEC_RETURN (0);
}
DEC_RETURN ([object] thingof (what));
}
function functionof (string|array what)
{
DEC_MSG ("functionof (%O)\n", what);
DEC_RETURN ([function] thingof (what));
}
program programof (string|array what)
{
DEC_MSG ("programof (%O)\n", what);
DEC_RETURN ([program] thingof (what));
}
//! Restore the state of an encoded object.
//!
//! @param o
//! Object to modify.
//!
//! @param data
//! State information from @[Encoder()->encode_object()].
//!
//! The default implementation calls @expr{o->_decode(data)@}
//! if the object has an @expr{_decode()@}, otherwise if
//! @[data] is an array, returns it to indicate that @[lfun::create()]
//! should be called.
//!
//! @note
//! This function is called @b{before@} @[lfun::create()]
//! in the object has been called, but after @[lfun::__INIT()]
//! has been called.
//!
//! @returns
//! Returns an array to indicate to the caller that
//! @[lfun::create()] should be called with the elements
//! of the array as arguments.
//!
//! Returns @expr{0@} (zero) to inhibit calling of @[lfun::create()].
//!
//! @seealso
//! @[Encoder()->encode_object()]
array(mixed) decode_object(object o, mixed data)
{
DEC_MSG ("decode_object (object(%O), %O)\n", object_program (o), data);
if(!o->_decode) {
if (!arrayp(data)) {
error ("Cannot decode object(%O) without _decode function.\n",
object_program (o));
}
// Try calling lfun::create().
return data;
}
([function(mixed:void)]o->_decode)(data);
return 0;
}
}
// Note: This mapping is not for caching but for coping with recursion
// problems by returning the same codec for the same file. As a cache
// it's really pointless.
protected mapping(string:Decoder) codecs = set_weak_flag (([]), 1);
Decoder get_codec(string|void fname, int|void mkobj, void|object handler)
{
if (handler)
// Decoders are currently not reused in this case since it's
// tricky to set up a weak multilevel mapping for lookup. This is
// seldom a problem since explicit handlers are fairly rare. If it
// is then the handler can always override this function.
return Decoder (fname, mkobj, handler);
string key = fname + "\0" + mkobj;
if (codecs[key]) return codecs[key];
return codecs[key] = Decoder(fname, mkobj);
}
class Codec
//! @appears Pike.Codec
//!
//! @[Encoder] and @[Decoder] rolled into one. This is for mainly
//! compatibility; there's typically no use combining encoding and
//! decoding into the same object.
{
inherit Encoder;
inherit Decoder;
protected void create (void|mixed encoded)
//! The optional argument is the thing to encode; it's passed on to
//! @[Encoder].
{
Encoder::create (encoded);
}
}
// Compat. The master used to act as the default codec.
inherit Codec;
//! Contains version information about a Pike version.
class Version
{
//! The major and minor parts of the version.
int major;
int minor;
//! @decl void create(int major, int minor)
//! Set the version in the object.
protected void create(int maj, int min)
{
if(maj==-1) maj = __REAL_MAJOR__;
if(min==-1) min = __REAL_MINOR__;
major = maj;
minor = min;
}
#define CMP(X) ((major - ([object]X)->major) || (minor - ([object]X)->minor))
//! Methods define so that version objects
//! can be compared and ordered.
protected int `<(mixed v) { return objectp(v) && CMP(v) < 0; }
protected int `>(mixed v) { return objectp(v) && CMP(v) > 0; }
protected int `==(mixed v) { return objectp(v) && CMP(v)== 0; }
protected int __hash() { return major * 4711 + minor ; }
protected string _sprintf(int t) {
switch(t) {
case 's': return sprintf("%d.%d",major,minor);
case 'O': return sprintf("%O(%s)", this_program, this);
}
}
//! The version object can be casted into a string.
protected mixed cast(string type)
{
if( type=="string" )
return sprintf("%d.%d",major,minor);
return UNDEFINED;
}
}
//! Version information about the current Pike version.
Version currentversion = Version(__REAL_MAJOR__, __REAL_MINOR__);
Version lowestcompat = Version(Builtin.LOWEST_COMPAT_MAJOR,
Builtin.LOWEST_COMPAT_MINOR);
mapping(Version:CompatResolver) compat_handler_cache = ([
currentversion:this_object(),
]);
CompatResolver get_compilation_handler(int major, int minor)
{
Version v=Version(major,minor);
if(v > currentversion)
{
/* Do we want to make an error if major.minor > __MAJOR__.__MINOR ?
*
* No; it's useful for referring to the next version when writing
* compat modules.
*/
return 0;
}
CompatResolver ret;
if(!undefinedp(ret=compat_handler_cache[v])) return ret;
array(string) files;
array(Version) available=({});
#if "#share_prefix#"[0]!='#'
if (!(files = master_get_dir("#share_prefix#"))) {
werror ("Error listing directory %O: %s\n",
"#share_prefix#", strerror (errno()));
files = ({});
}
foreach(files, string ver)
{
if(sscanf(ver,"%d.%d",int maj, int min))
{
Version x=Version(maj, min) ;
if(x >= v)
available|=({ x });
}
}
#endif
#if "#lib_prefix#"[0]!='#'
if (!(files = master_get_dir("#lib_prefix#"))) {
werror ("Error listing directory %O: %s\n",
"#lib_prefix#", strerror (errno()));
files = ({});
}
foreach(files, string ver)
{
if(sscanf(ver,"%d.%d",int maj, int min))
{
Version x=Version(maj, min) ;
if(x >= v)
available|=({ x });
}
}
#endif
sort(available);
#ifndef RESOLVER_HACK
/* We need to define RESOLVER_HACK when we add
* version-specific stuff in the CompatResolver.
* As long as all the compatibility is done in the
* module directories, RESOLVER_HACK can be undefined
*/
/* No compat needed */
if(!sizeof(available))
{
compat_handler_cache[v]=0;
return 0;
}
/* Same as available[0] */
if(ret=compat_handler_cache[available[0]])
return compat_handler_cache[v]=ret;
#endif
// The root resolver is this object.
ret = this;
foreach(reverse(available), Version tmp)
{
CompatResolver compat_handler = compat_handler_cache[tmp];
if (!compat_handler) {
// Create a new compat handler, that
// falls back to the successor version.
compat_handler = CompatResolver(tmp, ret);
string base;
#if "#lib_prefix#"[0]!='#'
base=combine_path("#lib_prefix#",sprintf("%s",tmp));
compat_handler->add_module_path(combine_path(base,"modules"));
compat_handler->add_include_path(combine_path(base,"include"));
#endif
#if "#share_prefix#"[0]!='#'
base=combine_path("#share_prefix#",sprintf("%s",tmp));
compat_handler->add_module_path(combine_path(base,"modules"));
compat_handler->add_include_path(combine_path(base,"include"));
#endif
// Kludge to avoid(?) recursive compilation problems. It was
// observed with a pike program containing
//
// #if constant (__builtin.security)
// #endif
//
// when using -V7.4. There was a cycle between resolving
// lib/modules/__builtin.pmod and lib/7.4/modules/__default.pmod.
compat_handler->get_default_module();
#ifndef RESOLVER_HACK
ret = compat_handler_cache[tmp] = compat_handler;
#endif
} else {
ret = compat_handler;
}
}
// Note: May duplicate the assignment above.
compat_handler_cache[v] = ret;
return ret;
}
string _sprintf(int t)
{
// NOTE: The ||'O' is for Pike 7.2 compat only.
switch(t||'O') {
// FIXME: What good is this lying for 't'? The master is still an
// object.. /mast
case 't': return "master";
case 'O': return "master()";
}
}
//! Return a master object compatible with the specified version of Pike.
//!
//! This function is used to implement the various compatibility versions
//! of @[master()].
//!
//! @seealso
//! @[get_compilation_handler()], @[master()]
object get_compat_master(int major, int minor)
{
if ((major < 7) || ((major == 7) && (minor < 9)))
return Pike_7_8_master::get_compat_master(major, minor);
// 7.9 and later.
return this;
}