pike.git
/
src
/
program.c
version
»
Context lines:
10
20
40
80
file
none
3
pike.git/src/program.c:1:
-
/*
-
|| 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.
-
*/
+
-
#include "global.h"
-
#include "program.h"
-
#include "object.h"
-
#include "dynamic_buffer.h"
-
#include "pike_types.h"
-
#include "stralloc.h"
-
#include "las.h"
-
#include "lex.h"
-
#include "pike_macros.h"
-
#include "fsort.h"
-
#include "pike_error.h"
-
#include "docode.h"
-
#include "interpret.h"
-
#include "hashtable.h"
-
#include "main.h"
-
#include "pike_memory.h"
-
#include "gc.h"
-
#include "threads.h"
-
#include "constants.h"
-
#include "operators.h"
-
#include "builtin_functions.h"
-
#include "stuff.h"
-
#include "mapping.h"
-
#include "cyclic.h"
-
#include "pike_security.h"
-
#include "pike_types.h"
-
#include "opcodes.h"
-
#include "version.h"
-
#include "block_alloc.h"
-
#include "pikecode.h"
-
#include "pike_compiler.h"
-
#include "module_support.h"
-
-
#include <errno.h>
-
#include <fcntl.h>
-
-
#define sp Pike_sp
-
-
#undef ATTRIBUTE
-
#define ATTRIBUTE(X)
-
-
static void low_enter_compiler(struct object *ce, int inherit);
-
static void exit_program_struct(struct program *);
-
static size_t add_xstorage(size_t size,
-
size_t alignment,
-
ptrdiff_t modulo_orig);
-
-
#undef EXIT_BLOCK
-
#define EXIT_BLOCK(P) exit_program_struct( (P) )
-
-
#undef COUNT_OTHER
-
#define COUNT_OTHER() do{ \
-
struct program *p; \
-
for(p=first_program;p;p=p->next) \
-
{ \
-
size+=p->total_size - sizeof (struct program); \
-
} \
-
}while(0)
-
-
BLOCK_ALLOC_FILL_PAGES(program, 4)
-
-
-
/* #define COMPILER_DEBUG */
-
/* #define PROGRAM_BUILD_DEBUG */
-
-
#ifdef COMPILER_DEBUG
-
#define CDFPRINTF(X) fprintf X
-
#else /* !COMPILER_DEBUG */
-
#define CDFPRINTF(X)
-
#endif /* COMPILER_DEBUG */
-
-
/*
-
* These two values should probably be fine-tuned, but doing so
-
* more or less requires running a predictable 'typical' application
-
* and testing different hashsizes and tresholds. I tried to do it
-
* mathematically by measuring the extremes (no cache hits, 100%
-
* cache hits etc.) but it seems that the processor cache becomes
-
* exhausted in some of my measurements, which renders my mathematical
-
* model useless.
-
*
-
* Further measurements seems to indicate that this cache can slow
-
* things down a bit if the hit/miss rate is not fairly high.
-
* For normal applications, the hitrate is most likely well over 90%,
-
* but that should be verified.
-
* - Holistiska Centralbyrån (Hubbe)
-
*/
-
-
/* Define the size of the cache that is used for method lookup. */
-
/* A value of zero disables this cache */
-
#define FIND_FUNCTION_HASHSIZE 16384
-
-
/* Programs with less methods will not use the cache for method lookups.. */
-
#define FIND_FUNCTION_HASH_TRESHOLD 9
-
-
-
#define DECLARE
-
#include "compilation.h"
-
-
struct pike_string *this_program_string;
-
static struct pike_string *this_string, *this_function_string;
-
static struct pike_string *UNDEFINED_string;
-
-
/* Common compiler subsystems */
-
struct pike_string *parser_system_string;
-
struct pike_string *type_check_system_string;
-
-
const char *const lfun_names[] = {
-
"__INIT",
-
"create",
-
"destroy",
-
"`+",
-
"`-",
-
"`&",
-
"`|",
-
"`^",
-
"`<<",
-
"`>>",
-
"`*",
-
"`/",
-
"`%",
-
"`~",
-
"`==",
-
"`<",
-
"`>",
-
"__hash",
-
"cast",
-
"`!",
-
"`[]",
-
"`[]=",
-
"`->",
-
"`->=",
-
"_sizeof",
-
"_indices",
-
"_values",
-
"`()",
-
"``+",
-
"``-",
-
"``&",
-
"``|",
-
"``^",
-
"``<<",
-
"``>>",
-
"``*",
-
"``/",
-
"``%",
-
"`+=",
-
"_is_type",
-
"_sprintf",
-
"_equal",
-
"_m_delete",
-
"_get_iterator",
-
"`[..]",
-
/* NOTE: After this point there are only fake lfuns. */
-
"_search",
-
"_types",
-
"_serialize",
-
"_deserialize",
-
};
-
-
struct pike_string *lfun_strings[NELEM(lfun_names)];
-
-
static struct mapping *lfun_ids;
-
-
/* mapping(string:type) */
-
static struct mapping *lfun_types;
-
-
static const char *const raw_lfun_types[] = {
-
tFuncV(tNone,tVoid,tVoid), /* "__INIT", */
-
tFuncV(tNone,tZero,tVoid), /* "create", */
-
tFuncV(tOr(tVoid,tInt),tVoid,tVoid), /* "destroy", */
-
tFuncV(tZero,tZero,tMix), /* "`+", */
-
tFunc(tOr(tVoid,tZero),tMix), /* "`-", */
-
tFuncV(tNone,tZero,tMix), /* "`&", */
-
tFuncV(tNone,tZero,tMix), /* "`|", */
-
tFuncV(tNone,tZero,tMix), /* "`^", */
-
tFuncV(tZero,tVoid,tMix), /* "`<<", */
-
tFuncV(tZero,tVoid,tMix), /* "`>>", */
-
tFuncV(tNone,tZero,tMix), /* "`*", */
-
tFuncV(tNone,tZero,tMix), /* "`/", */
-
tFuncV(tNone,tZero,tMix), /* "`%", */
-
tFuncV(tNone,tVoid,tMix), /* "`~", */
-
tFuncV(tMix,tVoid,tInt), /* "`==", */
-
tFuncV(tMix,tVoid,tInt), /* "`<", */
-
tFuncV(tMix,tVoid,tInt), /* "`>", */
-
tFuncV(tNone,tVoid,tInt), /* "__hash", */
-
tFuncV(tString,tVoid,tMix), /* "cast", */
-
tFuncV(tNone,tVoid,tInt), /* "`!", */
-
tFuncV(tZero,tVoid,tMix), /* "`[]", */
-
tFuncV(tZero tSetvar(0,tZero),tVoid,tVar(0)), /* "`[]=", */
-
tFuncV(tStr tOr(tVoid,tObj) tOr(tVoid,tInt),tVoid,tMix), /* "`->", */
-
tFuncV(tStr tSetvar(0,tZero) tOr(tVoid,tObj) tOr(tVoid,tInt),tVoid,tVar(0)), /* "`->=", */
-
tFuncV(tOr(tVoid,tObj) tOr(tVoid,tInt),tVoid,tInt), /* "_sizeof", */
-
tFuncV(tOr(tVoid,tObj) tOr(tVoid,tInt),tVoid,tArray), /* "_indices", */
-
tFuncV(tOr(tVoid,tObj) tOr(tVoid,tInt),tVoid,tArray), /* "_values", */
-
tFuncV(tNone,tZero,tMix), /* "`()", */
-
tFuncV(tZero,tZero,tMix), /* "``+", */
-
tFuncV(tZero,tVoid,tMix), /* "``-", */
-
tFuncV(tNone,tZero,tMix), /* "``&", */
-
tFuncV(tNone,tZero,tMix), /* "``|", */
-
tFuncV(tNone,tZero,tMix), /* "``^", */
-
tFuncV(tZero,tVoid,tMix), /* "``<<", */
-
tFuncV(tZero,tVoid,tMix), /* "``>>", */
-
tFuncV(tNone,tZero,tMix), /* "``*", */
-
tFuncV(tNone,tZero,tMix), /* "``/", */
-
tFuncV(tNone,tZero,tMix), /* "``%", */
-
tFuncV(tZero,tZero,tMix), /* "`+=", */
-
tFuncV(tStr,tVoid,tInt), /* "_is_type", */
-
tFuncV(tInt tOr(tMap(tStr,tInt),tVoid),tVoid,tStr), /* "_sprintf", */
-
tFuncV(tMix,tVoid,tInt), /* "_equal", */
-
tFuncV(tZero,tVoid,tMix), /* "_m_delete", */
-
tFuncV(tNone,tVoid,tObj), /* "_get_iterator", */
-
tFuncV(tZero tRangeBound tZero tRangeBound, tVoid, tMix), /* "`[..]" */
-
/* NOTE: After this point there are only fake lfuns. */
-
tFuncV(tZero tOr(tZero, tVoid), tVoid, tMix), /* "_search", */
-
tFuncV(tNone,tVoid,tArray), /* "_types", */
-
tFuncV(tObj tZero, tVoid, tVoid), /* "_serialize", */
-
tFuncV(tObj tZero, tVoid, tVoid), /* "_deserialize", */
-
};
-
-
/* These two are not true LFUNs! */
-
static struct pike_type *lfun_getter_type_string = NULL;
-
static struct pike_type *lfun_setter_type_string = NULL;
-
-
/*! @namespace lfun::
-
*!
-
*! Callback functions used to overload various builtin functions.
-
*!
-
*! The functions can be grouped into a few sets:
-
*!
-
*! @ul
-
*! @item
-
*! Object initialization and destruction.
-
*!
-
*! @[__INIT()], @[create()], @[destroy()]
-
*!
-
*! @item
-
*! Unary operator overloading.
-
*!
-
*! @[`~()], @[`!()],
-
*! @[_values()], @[cast()],
-
*! @[_sizeof()], @[_indices()],
-
*! @[__hash()]
-
*!
-
*! @item
-
*! Binary asymmetric operator overloading.
-
*!
-
*! @[`+()], @[``+()],
-
*! @[`-()], @[``-()],
-
*! @[`&()], @[``&()],
-
*! @[`|()], @[``|()],
-
*! @[`^()], @[``^()],
-
*! @[`<<()], @[``<<()],
-
*! @[`>>()], @[``>>()],
-
*! @[`*()], @[``*()],
-
*! @[`/()], @[``/()],
-
*! @[`%()], @[``%()]
-
*!
-
*! @item
-
*! Binary symmetric operator overloading.
-
*!
-
*! The optimizer will make assumptions about the relations
-
*! between these functions.
-
*!
-
*! @[`==()], @[_equal()], @[`<()], @[`>()]
-
*!
-
*! @item
-
*! Other binary operator overloading.
-
*!
-
*! @[`[]()], @[`[]=()], @[`->()],
-
*! @[`->=()], @[`+=()], @[`()()]
-
*!
-
*! @item
-
*! Overloading of other builtin functions.
-
*!
-
*! @[_is_type()], @[_sprintf()], @[_m_delete()],
-
*! @[_get_iterator()], @[_search()]
-
*! @endul
-
*!
-
*! @note
-
*! Although these functions are called from outside the object they
-
*! exist in, they will still be used even if they are declared
-
*! @expr{protected@}. It is in fact recommended to declare them
-
*! @expr{protected@}, since that will hinder them being used for
-
*! other purposes.
-
*!
-
*! @seealso
-
*! @[::]
-
*/
-
-
/*! @decl void lfun::__INIT()
-
*!
-
*! Inherit and variable initialization.
-
*!
-
*! This function is generated automatically by the compiler. It's
-
*! called just before @[lfun::create()] when an object is
-
*! instantiated.
-
*!
-
*! It first calls any @expr{__INIT@} functions in inherited classes
-
*! (regardless of modifiers on the inherits). It then executes all
-
*! the variable initialization expressions in this class, in the
-
*! order they occur.
-
*!
-
*! @note
-
*! This function can not be overloaded or blocked from executing.
-
*!
-
*! @seealso
-
*! @[lfun::create()]
-
*/
-
-
/*! @decl void lfun::create(zero ... args)
-
*!
-
*! Object creation callback.
-
*!
-
*! This function is called right after @[lfun::__INIT()].
-
*!
-
*! @[args] are the arguments passed when the program was called.
-
*!
-
*! @note
-
*! In Pike 7.2 and later this function can be created implicitly
-
*! by the compiler using the new syntax:
-
*! @code
-
*! class Foo(int foo) {
-
*! int bar;
-
*! }
-
*! @endcode
-
*! In the above case an implicit @[lfun::create()] is created, and
-
*! it's equvivalent to:
-
*! @code
-
*! class Foo {
-
*! int foo;
-
*! int bar;
-
*! protected void create(int foo)
-
*! {
-
*! local::foo = foo;
-
*! }
-
*! }
-
*! @endcode
-
*!
-
*! @seealso
-
*! @[lfun::__INIT()], @[lfun::destroy()]
-
*/
-
-
/*! @decl void lfun::destroy (void|int reason)
-
*!
-
*! Object destruction callback.
-
*!
-
*! This function is called right before the object is destructed.
-
*! That can happen either through a call to @[predef::destruct()],
-
*! when there are no more references to the object, or when the
-
*! garbage collector discovers that it's part of a cyclic data
-
*! structure that has become garbage.
-
*!
-
*! @param reason
-
*! A flag that tells why the object is destructed:
-
*!
-
*! @int
-
*! @value Object.DESTRUCT_EXPLICIT
-
*! Destructed explicitly by @[predef::destruct].
-
*! @value Object.DESTRUCT_NO_REFS
-
*! Destructed due to running out of references.
-
*! @value Object.DESTRUCT_GC
-
*! Destructed by the garbage collector.
-
*! @value Object.DESTRUCT_CLEANUP
-
*! Destructed as part of the cleanup when the pike process
-
*! exits. Occurs only if Pike has been compiled with the
-
*! configure option @tt{--with-cleanup-on-exit@}. See note
-
*! below.
-
*! @endint
-
*!
-
*! @note
-
*! Objects are normally not destructed when a process exits, so
-
*! @expr{destroy@} functions aren't called then. Use @[atexit] to get
-
*! called when the process exits.
-
*!
-
*! @note
-
*! Regarding destruction order during garbage collection:
-
*!
-
*! If an object is destructed by the garbage collector, it's part of
-
*! a reference cycle with other things but with no external
-
*! references. If there are other objects with @expr{destroy@}
-
*! functions in the same cycle, it becomes a problem which to call
-
*! first.
-
*!
-
*! E.g. if this object has a variable with another object which
-
*! (directly or indirectly) points back to this one, you might find
-
*! that the other object already has been destructed and the variable
-
*! thus contains zero.
-
*!
-
*! The garbage collector tries to minimize such problems by defining
-
*! an order as far as possible:
-
*!
-
*! @ul
-
*! @item
-
*! If an object A contains an @[lfun::destroy] and an object B does
-
*! not, then A is destructed before B.
-
*! @item
-
*! If A references B single way, then A is destructed before B.
-
*! @item
-
*! If A and B are in a cycle, and there is a reference somewhere
-
*! from B to A that is weaker than any reference from A to B, then
-
*! A is destructed before B.
-
*! @item
-
*! If a cycle is resolved according to the rule above by ignoring a
-
*! weaker reference, and there is another ambiguous cycle that
-
*! would get resolved by ignoring the same reference, then the
-
*! latter cycle will be resolved by ignoring that reference.
-
*! @item
-
*! Weak references (e.g. set with @[predef::set_weak_flag()]) are
-
*! considered weaker than normal references, and both are
-
*! considered weaker than strong references.
-
*! @item
-
*! Strong references are those from objects to the objects of their
-
*! lexically surrounding classes. There can never be a cycle
-
*! consisting only of strong references. (This means the gc never
-
*! destructs a parent object before all children have been
-
*! destructed.)
-
*! @endul
-
*!
-
*! An example with well defined destruct order due to strong
-
*! references:
-
*!
-
*! @code
-
*! class Super {
-
*! class Sub {
-
*! protected void destroy() {
-
*! if (!Super::this)
-
*! error ("My parent has been destructed!\n");
-
*! }
-
*! }
-
*! Sub sub = Sub();
-
*! protected void destroy() {
-
*! if (!sub)
-
*! werror ("sub already destructed.\n");
-
*! }
-
*! }
-
*! @endcode
-
*!
-
*! The garbage collector ensures that these objects are destructed in
-
*! an order so that @expr{werror@} in @expr{Super@} is called and not
-
*! @expr{error@} in @expr{Sub@}.
-
*!
-
*! @note
-
*! When the garbage collector calls @[lfun::destroy], all accessible
-
*! non-objects and objects without @expr{destroy@} functions are
-
*! still intact. They are not freed if the @expr{destroy@} function
-
*! adds external references to them. However, all objects with
-
*! @[lfun::destroy] in the cycle are already scheduled for
-
*! destruction and will therefore be destroyed even if external
-
*! references are added to them.
-
*!
-
*! @note
-
*! The garbage collector had completely random destruct order in
-
*! versions prior to 7.2.
-
*!
-
*! @seealso
-
*! @[lfun::create()], @[predef::destruct()]
-
*/
-
-
/*! @decl mixed lfun::`+(zero arg, zero ... rest)
-
*!
-
*! Left side addition/concatenation callback.
-
*!
-
*! This is used by @[predef::`+]. It's called with any arguments
-
*! that follow this object in the argument list of the call to
-
*! @[predef::`+]. The returned value should be a new instance that
-
*! represents the addition/concatenation between this object and
-
*! the arguments in the order they are given.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``+()], @[lfun::`+=()], @[predef::`+()]
-
*/
-
-
/*! @decl this_program lfun::`+=(zero arg, zero ... rest)
-
*!
-
*! Destructive addition/concatenation callback.
-
*!
-
*! This is used by @[predef::`+]. It's called with any arguments
-
*! that follow this object in the argument list of the call to
-
*! @[predef::`+]. It should update this object to represent the
-
*! addition/concatenation between it and the arguments in the order
-
*! they are given. It should always return this object.
-
*!
-
*! @note
-
*! This function should only be implemented if @[lfun::`+()] also
-
*! is. It should only work as a more optimized alternative to that
-
*! one, for the case when it's safe to change the object
-
*! destructively and use it directly as the result.
-
*!
-
*! @note
-
*! This function is not an lfun for the @expr{+=@} operator. It's
-
*! only whether or not it's safe to do a destructive change that
-
*! decides if this function or @[lfun::`+()] is called; both the
-
*! @expr{+@} operator and the @expr{+=@} operator can call either
-
*! one.
-
*!
-
*! @seealso
-
*! @[lfun::`+()], @[predef::`+()]
-
*/
-
-
/*! @decl mixed lfun::``+(zero arg, zero ... rest)
-
*!
-
*! Right side addition/concatenation callback.
-
*!
-
*! This is used by @[predef::`+]. It's called with any arguments
-
*! that precede this object in the argument list of the call to
-
*! @[predef::`+]. The returned value should be a new instance that
-
*! represents the addition/concatenation between the arguments in
-
*! the order they are given and this object.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`+()], @[predef::`+()]
-
*/
-
-
/*! @decl mixed lfun::`-(void|zero arg)
-
*!
-
*! Negation and left side subtraction/set difference callback.
-
*!
-
*! This is used by @[predef::`-]. When called without an argument
-
*! the result should be a new instance that represents the negation
-
*! of this object, otherwise the result should be a new instance
-
*! that represents the difference between this object and @[arg].
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``-()], @[predef::`-()]
-
*/
-
-
/*! @decl mixed lfun::``-(zero arg)
-
*!
-
*! Right side subtraction/set difference callback.
-
*!
-
*! This is used by @[predef::`-]. The result should be a new
-
*! instance that represents the difference between @[arg] and this
-
*! object.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`-()], @[predef::`-()]
-
*/
-
-
/*! @decl mixed lfun::`&(zero ... args)
-
*!
-
*! Left side bitwise and/intersection callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``&()], @[predef::`&()]
-
*/
-
-
/*! @decl mixed lfun::``&(zero ... args)
-
*!
-
*! Right side bitwise and/intersection callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`&()], @[predef::`&()]
-
*/
-
-
/*! @decl mixed lfun::`|(zero ... args)
-
*!
-
*! Left side bitwise or/union callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``|()], @[predef::`|()]
-
*/
-
-
/*! @decl mixed lfun::``|(zero ... args)
-
*!
-
*! Right side bitwise or/union callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`|()], @[predef::`|()]
-
*/
-
-
/*! @decl mixed lfun::`^(zero ... args)
-
*!
-
*! Left side exclusive or callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``^()], @[predef::`^()]
-
*/
-
-
/*! @decl mixed lfun::``^(zero ... args)
-
*!
-
*! Right side exclusive or callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`^()], @[predef::`^()]
-
*/
-
-
/*! @decl mixed lfun::`<<(zero arg)
-
*!
-
*! Left side left shift callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``<<()], @[predef::`<<()]
-
*/
-
-
/*! @decl mixed lfun::``<<(zero arg)
-
*!
-
*! Right side left shift callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`<<()], @[predef::`<<()]
-
*/
-
-
/*! @decl mixed lfun::`>>(zero arg)
-
*!
-
*! Left side right shift callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``>>()], @[predef::`>>()]
-
*/
-
-
/*! @decl mixed lfun::``>>(zero arg)
-
*!
-
*! Right side right shift callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`>>()], @[predef::`>>()]
-
*/
-
-
/*! @decl mixed lfun::`*(zero ... args)
-
*!
-
*! Left side multiplication/repetition/implosion callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``*()], @[predef::`*()]
-
*/
-
-
/*! @decl mixed lfun::``*(zero ... args)
-
*!
-
*! Right side multiplication/repetition/implosion callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`*()], @[predef::`*()]
-
*/
-
-
/*! @decl mixed lfun::`/(zero ... args)
-
*!
-
*! Left side division/split callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``/()], @[predef::`/()]
-
*/
-
-
/*! @decl mixed lfun::``/(zero ... args)
-
*!
-
*! Right side division/split callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`/()], @[predef::`/()]
-
*/
-
-
/*! @decl mixed lfun::`%(zero ... args)
-
*!
-
*! Left side modulo callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::``%()], @[predef::`%()]
-
*/
-
-
/*! @decl mixed lfun::``%(zero ... args)
-
*!
-
*! Right side modulo callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`%()], @[predef::`%()]
-
*/
-
-
/*! @decl int lfun::`!()
-
*!
-
*! Logical not callback.
-
*!
-
*! @returns
-
*! Returns non-zero if the object should be evaluated as false,
-
*! and @expr{0@} (zero) otherwise.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::`!()]
-
*/
-
-
/*! @decl mixed lfun::`~()
-
*!
-
*! Complement/inversion callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::`~()]
-
*/
-
-
/*! @decl int(0..1) lfun::`==(mixed arg)
-
*!
-
*! Equality test callback.
-
*!
-
*! @note
-
*! If this is implemented it might be necessary to implement
-
*! @[lfun::__hash] too. Otherwise mappings might hold several
-
*! objects as indices which are duplicates according to this
-
*! function. Various other functions that use hashing also might
-
*! not work correctly, e.g. @[predef::Array.uniq].
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::`==()], @[lfun::__hash]
-
*/
-
-
/*! @decl int(0..1) lfun::`<(mixed arg)
-
*!
-
*! Less than test callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::`<()]
-
*/
-
-
/*! @decl int(0..1) lfun::`>(mixed arg)
-
*!
-
*! Greater than test callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::`>()]
-
*/
-
-
/*! @decl int lfun::__hash()
-
*!
-
*! Hashing callback.
-
*!
-
*! The main caller of this function is @[predef::hash_value()]
-
*! or the low-level equvivalent, which get called by various
-
*! mapping operations when the object is used as index in a mapping.
-
*!
-
*! @returns
-
*! It should return an integer that corresponds to the object
-
*! in such a way that all values which @[lfun::`==] considers
-
*! equal to the object get the same hash value.
-
*!
-
*! @note
-
*! The function @[predef::hash] does not return hash values that
-
*! are compatible with this one.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[lfun::`==], @[predef::hash_value()]
-
*/
-
-
/*! @decl mixed lfun::cast(string requested_type)
-
*!
-
*! Value cast callback.
-
*!
-
*! @param requested_type
-
*! Type to cast to.
-
*!
-
*! @returns
-
*! Expected to return the object value-casted (converted) to
-
*! the type described by @[requested_type].
-
*!
-
*! @note
-
*! The argument is currently a string with the name
-
*! of the type, but might in the future be a value of the type type.
-
*!
-
*! @note
-
*! Currently casting between object types is a noop.
-
*!
-
*! @note
-
*! If the returned value is not deemed to be of the requested type
-
*! a runtime error may be thrown.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*/
-
-
/*! @decl mixed lfun::`[..](zero low, int low_bound_type, @
-
*! zero high, int high_bound_type)
-
*!
-
*! Subrange callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::`[..]]
-
*/
-
-
/*! @decl mixed lfun::`[](zero arg1, zero|void arg2)
-
*!
-
*! Indexing callback.
-
*!
-
*! For compatibility, this is also called to do subranges unless
-
*! there is a @[`[..]] in the class. See @[predef::`[..]] for
-
*! details.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::`[]()], @[predef::`[..]]
-
*/
-
-
/*! @decl mixed lfun::`[]=(zero arg1, zero arg2)
-
*!
-
*! Index assignment callback.
-
*!
-
*! @seealso
-
*! @[predef::`[]=()], @[lfun::`->=()]
-
*/
-
-
/*! @decl mixed lfun::`->(string arg, object|void context, int|void access)
-
*!
-
*! Arrow index callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::`->()], @[::`->()]
-
*/
-
-
/*! @decl mixed lfun::`->=(string arg, zero value, @
-
*! object|void context, int|void access)
-
*!
-
*! Arrow index assignment callback.
-
*!
-
*! @seealso
-
*! @[predef::`->=()], @[::`->=()], @[lfun::`[]=()]
-
*/
-
-
/*! @decl int lfun::_sizeof()
-
*!
-
*! Size query callback.
-
*!
-
*! Called by @[predef::sizeof()] to determine the number of elements
-
*! in an object. If this function is not present, the number
-
*! of public symbols in the object will be returned.
-
*!
-
*! @returns
-
*! Expected to return the number of valid indices in the object.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::sizeof()]
-
*/
-
-
/*! @decl array lfun::_indices(object|void context, int|void access)
-
*!
-
*! List indices callback.
-
*!
-
*! @returns
-
*! Expected to return an array with the valid indices in the object.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::indices()], @[lfun::_values()], @[lfun::_types()],
-
*! @[::_indices()]
-
*/
-
-
/*! @decl array lfun::_values(object|void context, int|void access)
-
*!
-
*! List values callback.
-
*!
-
*! @returns
-
*! Expected to return an array with the values corresponding to
-
*! the indices returned by @[lfun::_indices()].
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::values()], @[lfun::_indices()], @[lfun::_types()],
-
*! @[::_values()]
-
*/
-
-
/*! @decl mixed lfun::`()(zero ... args)
-
*!
-
*! Apply callback.
-
*!
-
*! @seealso
-
*! @[predef::`()]
-
*/
-
-
/*! @decl int(0..1) lfun::_is_type(string basic_type)
-
*!
-
*! Type comparison callback.
-
*!
-
*! Called by the cast operator to determine if an object
-
*! simulates a basic type.
-
*!
-
*! @param basic_type
-
*! One of:
-
*! @string
-
*! @value "array"
-
*! @value "float"
-
*! @value "function"
-
*! @value "int"
-
*! @value "mapping"
-
*! @value "multiset"
-
*! @value "object"
-
*! @value "program"
-
*! @value "string"
-
*! @value "type"
-
*! @value "void"
-
*! @value "zero"
-
*! @endstring
-
*!
-
*! The following five shouldn't occurr, but are here for completeness:
-
*! @string
-
*! @value "lvalue"
-
*! @value "mapping_data"
-
*! @value "object storage"
-
*! @value "pike_frame"
-
*! @value "unknown"
-
*! @endstring
-
*!
-
*! @returns
-
*! Expected to return @expr{1@} if the object is to be regarded as a
-
*! simulation of the type specified by @[basic_type].
-
*!
-
*! @note
-
*! The argument is currently a string with the name
-
*! of the type, but might in the future be a value of the type type.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*/
-
-
/*! @decl string lfun::_sprintf(int conversion_type, @
-
*! mapping(string:int)|void params)
-
*!
-
*! Sprintf callback.
-
*!
-
*! This method is called by @[predef::sprintf()] to print objects. If it is
-
*! not present, printing of the object will not be supported for any
-
*! conversion-type except for the @tt{%O@}-conversion-type, which
-
*! will output @expr{"object"@}.
-
*!
-
*! @param conversion_type
-
*! One of:
-
*! @int
-
*! @value 'b'
-
*! Signed binary integer.
-
*! @value 'd'
-
*! Signed decimal integer.
-
*! @value 'u'
-
*! Unsigned decimal integer.
-
*! @value 'o'
-
*! Signed octal integer.
-
*! @value 'x'
-
*! Lowercase signed hexadecimal integer.
-
*! @value 'X'
-
*! Uppercase signed hexadecimal integer.
-
*! @value 'c'
-
*! Character. If a fieldsize has been specified this will output
-
*! the low-order bytes of the integer in network byte order.
-
*! @value 'f'
-
*! Float.
-
*! @value 'g'
-
*! Heuristically chosen representation of float.
-
*! @value 'G'
-
*! Like @tt{%g@}, but uses uppercase @tt{E@} for exponent.
-
*! @value 'e'
-
*! Exponential notation float.
-
*! @value 'E'
-
*! Like @tt{%e@}, but uses uppercase @tt{E@} for exponent.
-
*! @value 's'
-
*! String.
-
*! @value 'O'
-
*! Any value (debug style).
-
*! @value 't'
-
*! Type of the argument.
-
*! @endint
-
*!
-
*! @param params
-
*! Conversion parameters. The following parameters may be supplied:
-
*! @mapping
-
*! @member int "precision"
-
*! Precision.
-
*! @member int "width"
-
*! Field width.
-
*! @member int(1..1) "flag_left"
-
*! Indicates that the output should be left-aligned.
-
*! @member int "indent"
-
*! Indentation level in @tt{%O@}-mode.
-
*! @endmapping
-
*!
-
*! @returns
-
*! Is expected to return a string describing the object formatted
-
*! according to @[conversion_type].
-
*!
-
*! @note
-
*! @[_sprintf()] is currently not called for the following
-
*! conversion-types:
-
*! @int
-
*! @value 'F'
-
*! Binary IEEE representation of float (@tt{%4F@} gives
-
*! single precision, @tt{%8F@} gives double precision.)
-
*! @endint
-
*!
-
*! @note
-
*! This function might be called at odd times, e.g. before
-
*! @[lfun::create] has been called or when an error has occurred.
-
*! The reason is typically that it gets called when a backtrace is
-
*! being formatted to report an error. It should therefore be very
-
*! robust and not make any assumptions about its own internal
-
*! state, at least not when @[conversion_type] is @expr{'O'@}.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::sprintf()]
-
*/
-
-
/*! @decl int lfun::_equal(mixed arg)
-
*!
-
*! Recursive equality callback.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::equal()], @[lfun::`==()]
-
*/
-
-
/*! @decl mixed lfun::_m_delete(mixed arg)
-
*!
-
*! Delete index callback.
-
*!
-
*! @seealso
-
*! @[predef::m_delete()]
-
*/
-
-
/*! @decl predef::Iterator lfun::_get_iterator()
-
*!
-
*! Iterator creation callback.
-
*!
-
*! The returned @[predef::Iterator] instance works as a cursor that
-
*! references a specific item contained (in some arbitrary sense)
-
*! in this one.
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @seealso
-
*! @[predef::Iterator], @[predef::get_iterator], @[predef::foreach()]
-
*/
-
-
/*! @decl mixed lfun::_search(mixed needle, mixed|void start)
-
*!
-
*! Search callback.
-
*!
-
*! @seealso
-
*! @[predef::search()]
-
*/
-
-
/*! @decl array lfun::_types(object|void context, int|void access)
-
*!
-
*! List types callback.
-
*!
-
*! This callback is typically called via @[predef::types()].
-
*!
-
*! @returns
-
*! Expected to return an array with the types corresponding to
-
*! the indices returned by @[lfun::_indices()].
-
*!
-
*! @note
-
*! It's assumed that this function is side-effect free.
-
*!
-
*! @note
-
*! @[predef::types()] was added in Pike 7.9.
-
*!
-
*! @seealso
-
*! @[predef::types()], @[lfun::_indices()], @[lfun::_values()],
-
*! @[::_types()]
-
*/
-
-
/*! @decl void lfun::_serialize(object o, @
-
*! function(mixed, string, type:void) serializer)
-
*!
-
*! Dispatch function for @[Serializer.serialize()].
-
*!
-
*! @param o
-
*! Object to serialize. Always a context of the current object.
-
*!
-
*! @param serializer
-
*! Function to be called once for every variable
-
*! to serialize.
-
*!
-
*! The @[serializer] function expects to be called with three arguments:
-
*! @dl
-
*! @item
-
*! @tt{value@} - The value of the symbol.
-
*! @item
-
*! @tt{symbol@} - The symbol name.
-
*! @item
-
*! @tt{symbol_type@} - The type of the symbol.
-
*! @enddl
-
*!
-
*! @note
-
*! A default implementation of @[lfun::_serialize()] and
-
*! @[lfun::_deserialize()] is available in @[Serializer.Serializable].
-
*!
-
*! @seealso
-
*! @[lfun::_deserialize()], @[Serializer.serialize()],
-
*! @[Serializer.Serializable()->_serialize()]
-
*/
-
-
/*! @decl void lfun::_deserialize(object o, @
-
*! function(function(mixed:void), @
-
*! string, type: mixed) deserializer)
-
*!
-
*! Dispatch function for @[Serialization.deserialize()].
-
*!
-
*! @param o
-
*! Object to serialize. Always a context of the current object.
-
*!
-
*! @param deserializer
-
*! Function to be called once for every variable
-
*! to serialize.
-
*!
-
*! The @[deserializer] function expects to be called with three arguments:
-
*! @dl
-
*! @item
-
*! @tt{setter@} - Function that sets the symbol value.
-
*! @item
-
*! @tt{symbol@} - The symbol name.
-
*! @item
-
*! @tt{symbol_type@} - The type of the symbol.
-
*! @enddl
-
*!
-
*! @note
-
*! A default implementation of @[lfun::_serialize()] and
-
*! @[lfun::_deserialize()] is available in @[Serializer.Serializable].
-
*!
-
*! @seealso
-
*! @[lfun::_serialize()], @[Serializer.deserialize()],
-
*! @[Serializer.Serializable()->_deserialize()]
-
*/
-
-
/*! @decl mixed lfun::`symbol()
-
*! @decl mixed lfun::`->symbol()
-
*!
-
*! Variable retrieval callback (aka "getter").
-
*!
-
*! @note
-
*! Note that the @expr{symbol@} in the name can be any symbol.
-
*!
-
*! @note
-
*! This is not a true LFUN, since it is even more low level!
-
*!
-
*! @note
-
*! This function WILL be called even by inheriting programs
-
*! when they attempt to access the variable named @expr{symbol@}.
-
*!
-
*! @seealso
-
*! @[lfun::`->symbol=()], @[lfun::`->()]
-
*/
-
-
/*! @decl void lfun::`symbol=(zero value)
-
*! @decl void lfun::`->symbol=(zero value)
-
*!
-
*! Variable assignment callback (aka "setter").
-
*!
-
*! @note
-
*! Note that the @expr{symbol@} in the name can be any symbol.
-
*!
-
*! @note
-
*! This is not a true LFUN, since it is even more low level!
-
*!
-
*! @note
-
*! This function WILL be called even by inheriting programs
-
*! when they attempt to set the variable named @expr{symbol@}.
-
*!
-
*! @seealso
-
*! @[lfun::`->symbol()], @[lfun::`->=()]
-
*/
-
-
/*! @endnamespace
-
*/
-
-
/*! @class MasterObject
-
*/
-
-
/*! @decl void unregister(program p)
-
*!
-
*! Unregister a program that was only partially compiled.
-
*!
-
*! Called by @[compile()] to clean up references to partially compiled
-
*! programs.
-
*!
-
*! @param p
-
*! Partially compiled program that should no longer be referenced.
-
*!
-
*! @fixme
-
*! Shouldn't this function be in the compilation handler?
-
*/
-
-
/*! @endclass
-
*/
-
-
/*! @class CompilationHandler
-
*/
-
-
/*! @decl mapping(string:mixed)|object get_default_module()
-
*!
-
*! Returns the default module from which global symbols will
-
*! be fetched.
-
*!
-
*! @returns
-
*! Returns the default module, or @expr{0@} (zero).
-
*!
-
*! If @expr{0@} (zero) is returned the compiler use the mapping
-
*! returned by @[all_constants()] as fallback.
-
*!
-
*! @seealso
-
*! @[get_predefines()]
-
*/
-
-
/*! @decl void compile_warning(string filename, int line, string msg)
-
*!
-
*! Called by @[compile()] to report warnings.
-
*!
-
*! @param filename
-
*! File which triggered the warning.
-
*!
-
*! @param line
-
*! Line which triggered the warning.
-
*!
-
*! @param msg
-
*! Warning message.
-
*!
-
*! @seealso
-
*! @[compile_error()]
-
*/
-
-
/*! @endclass
-
*/
-
-
struct program *first_program = 0;
-
static int current_program_id = PROG_DYNAMIC_ID_START;
-
-
struct program *null_program=0;
-
-
static struct program *reporter_program = NULL;
-
struct program *compilation_program = 0;
-
struct program *compilation_env_program = 0;
-
struct object *compilation_environment = NULL;
-
-
struct program *gc_internal_program = 0;
-
static struct program *gc_mark_program_pos = 0;
-
-
#ifdef PIKE_DEBUG
-
#define CHECK_FILE_ENTRY(PROG, POS, LEN, SHIFT) \
-
do { \
-
if (SHIFT < 0 || SHIFT > 2 || \
-
POS + (LEN << SHIFT) > PROG->linenumbers + PROG->num_linenumbers) \
-
Pike_fatal ("Invalid file entry in linenumber info.\n"); \
-
} while (0)
-
#else
-
#define CHECK_FILE_ENTRY(PROG, POS, LEN, SHIFT) do {} while (0)
-
#endif
-
-
INT_TYPE get_small_number(char **q);
-
-
PMOD_EXPORT void do_free_program (struct program *p)
-
{
-
if (p)
-
free_program(p);
-
}
-
-
/* So what if we don't have templates? / Hubbe */
-
-
#ifdef PIKE_DEBUG
-
#define CHECK_FOO(NUMTYPE,TYPE,NAME) \
-
if(Pike_compiler->malloc_size_program-> PIKE_CONCAT(num_,NAME) < \
-
Pike_compiler->new_program-> PIKE_CONCAT(num_,NAME)) \
-
Pike_fatal("Pike_compiler->new_program->num_" #NAME " is out of order\n");\
-
if(Pike_compiler->new_program->flags & PROGRAM_OPTIMIZED) \
-
Pike_fatal("Tried to reallocate fixed program.\n")
-
-
#else
-
#define CHECK_FOO(NUMTYPE,TYPE,NAME)
-
#endif
-
-
#ifndef RELOCATE_program
-
#define RELOCATE_program(ORIG, NEW)
-
#endif /* !RELOCATE_program */
-
#define RELOCATE_identifier_cache(ORIG,NEW)
-
#define RELOCATE_linenumbers(ORIG,NEW)
-
#define RELOCATE_identifier_index(ORIG,NEW)
-
#define RELOCATE_variable_index(ORIG,NEW)
-
#define RELOCATE_identifier_references(ORIG,NEW)
-
#define RELOCATE_strings(ORIG,NEW)
-
#define RELOCATE_inherits(ORIG,NEW)
-
#define RELOCATE_identifiers(ORIG,NEW)
-
#define RELOCATE_constants(ORIG,NEW)
-
#define RELOCATE_relocations(ORIG,NEW)
-
-
#if SIZEOF_LONG_LONG == 8
-
/* we have 8 byte ints, hopefully this constant works on all these systems */
-
#define MAXVARS(NUMTYPE) \
-
(NUMTYPE)(sizeof(NUMTYPE)==1?254: \
-
(sizeof(NUMTYPE)==2?65534: \
-
(sizeof(NUMTYPE)==4?4294967294U:18446744073709551614ULL)))
-
#else
-
#define MAXVARS(NUMTYPE) \
-
(NUMTYPE)(sizeof(NUMTYPE)==1?254: (sizeof(NUMTYPE)==2?65534:4294967294U))
-
#endif
-
-
#ifdef PIKE_USE_MACHINE_CODE
-
/* Special cases for low_add_to_program and add_to_program since
-
* many OSes require us to use mmap to allocate memory for our
-
* machine code. For decoding efficiency we also want a multi copy
-
* variant to be used by decode().
-
*/
-
#define BAR(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
void PIKE_CONCAT(low_add_to_,NAME) (struct program_state *state, \
-
TYPE ARG) { \
-
NUMTYPE m = state->malloc_size_program->PIKE_CONCAT(num_,NAME); \
-
CHECK_FOO(NUMTYPE,TYPE,NAME); \
-
if(m == state->new_program->PIKE_CONCAT(num_,NAME)) { \
-
TYPE *tmp; \
-
if(m==MAXVARS(NUMTYPE)) { \
-
yyerror("Too many " #NAME "."); \
-
return; \
-
} \
-
m = MINIMUM(m*2+1,MAXVARS(NUMTYPE)); \
-
tmp = mexec_realloc((void *)state->new_program->NAME, \
-
sizeof(TYPE) * m); \
-
if(!tmp) Pike_fatal("Out of memory.\n"); \
-
PIKE_CONCAT(RELOCATE_,NAME)(state->new_program, tmp); \
-
state->malloc_size_program->PIKE_CONCAT(num_,NAME)=m; \
-
state->new_program->NAME=tmp; \
-
} \
-
state->new_program-> \
-
NAME[state->new_program->PIKE_CONCAT(num_,NAME)++]=(ARG); \
-
} \
-
void PIKE_CONCAT(low_add_many_to_,NAME) (struct program_state *state, \
-
TYPE *ARG, NUMTYPE cnt) { \
-
NUMTYPE m = state->malloc_size_program->PIKE_CONCAT(num_,NAME); \
-
CHECK_FOO(NUMTYPE,TYPE,NAME); \
-
if((m + cnt) > state->new_program->PIKE_CONCAT(num_,NAME)) { \
-
TYPE *tmp; \
-
NUMTYPE n = m; \
-
do { \
-
if(n==MAXVARS(NUMTYPE)) { \
-
yyerror("Too many " #NAME "."); \
-
return; \
-
} \
-
n = MINIMUM(n*2+1,MAXVARS(NUMTYPE)); \
-
} while (m + cnt > n); \
-
m = n; \
-
tmp = mexec_realloc((void *)state->new_program->NAME, \
-
sizeof(TYPE) * m); \
-
if(!tmp) Pike_fatal("Out of memory.\n"); \
-
PIKE_CONCAT(RELOCATE_,NAME)(state->new_program, tmp); \
-
state->malloc_size_program->PIKE_CONCAT(num_,NAME)=m; \
-
state->new_program->NAME=tmp; \
-
} \
-
MEMCPY(state->new_program->NAME + \
-
state->new_program->PIKE_CONCAT(num_,NAME), \
-
ARG, sizeof(TYPE) * cnt); \
-
state->new_program->PIKE_CONCAT(num_,NAME) += cnt; \
-
} \
-
void PIKE_CONCAT(add_to_,NAME) (ARGTYPE ARG) { \
-
PIKE_CONCAT(low_add_to_,NAME) ( Pike_compiler, ARG ); \
-
}
-
#else /* !PIKE_USE_MACHINE_CODE */
-
#define BAR(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
FOO(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
void PIKE_CONCAT(low_add_many_to_,NAME) (struct program_state *state, \
-
TYPE *ARG, NUMTYPE cnt) { \
-
NUMTYPE m = state->malloc_size_program->PIKE_CONCAT(num_,NAME); \
-
CHECK_FOO(NUMTYPE,TYPE,NAME); \
-
if((m + cnt) > state->new_program->PIKE_CONCAT(num_,NAME)) { \
-
TYPE *tmp; \
-
NUMTYPE n = m; \
-
do { \
-
if(n==MAXVARS(NUMTYPE)) { \
-
yyerror("Too many " #NAME "."); \
-
return; \
-
} \
-
n = MINIMUM(n*2+1,MAXVARS(NUMTYPE)); \
-
} while (m + cnt > n); \
-
m = n; \
-
tmp = realloc((void *)state->new_program->NAME, \
-
sizeof(TYPE) * m); \
-
if(!tmp) Pike_fatal("Out of memory.\n"); \
-
PIKE_CONCAT(RELOCATE_,NAME)(state->new_program, tmp); \
-
state->malloc_size_program->PIKE_CONCAT(num_,NAME)=m; \
-
state->new_program->NAME=tmp; \
-
} \
-
MEMCPY(state->new_program->NAME + \
-
state->new_program->PIKE_CONCAT(num_,NAME), \
-
ARG, sizeof(TYPE) * cnt); \
-
state->new_program->PIKE_CONCAT(num_,NAME) += cnt; \
-
}
-
#endif /* PIKE_USE_MACHINE_CODE */
-
-
/* Funny guys use the uppermost value for nonexistant variables and
-
the like. Hence -2 and not -1. Y2K. */
-
#define FOO(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
void PIKE_CONCAT(low_add_to_,NAME) (struct program_state *state, \
-
TYPE ARG) { \
-
NUMTYPE m = state->malloc_size_program->PIKE_CONCAT(num_,NAME); \
-
CHECK_FOO(NUMTYPE,TYPE,NAME); \
-
if(m == state->new_program->PIKE_CONCAT(num_,NAME)) { \
-
TYPE *tmp; \
-
if(m==MAXVARS(NUMTYPE)) { \
-
yyerror("Too many " #NAME "."); \
-
return; \
-
} \
-
m = MINIMUM(m*2+1,MAXVARS(NUMTYPE)); \
-
tmp = realloc((void *)state->new_program->NAME, \
-
sizeof(TYPE) * m); \
-
if(!tmp) Pike_fatal("Out of memory.\n"); \
-
PIKE_CONCAT(RELOCATE_,NAME)(state->new_program, tmp); \
-
state->malloc_size_program->PIKE_CONCAT(num_,NAME)=m; \
-
state->new_program->NAME=tmp; \
-
} \
-
state->new_program-> \
-
NAME[state->new_program->PIKE_CONCAT(num_,NAME)++]=(ARG); \
-
} \
-
void PIKE_CONCAT(add_to_,NAME) (ARGTYPE ARG) { \
-
PIKE_CONCAT(low_add_to_,NAME) ( Pike_compiler, ARG ); \
-
}
-
-
/* Funny guys use the uppermost value for nonexistant variables and
-
the like. Hence -2 and not -1. Y2K. */
-
#define PASS1ONLY(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
void PIKE_CONCAT(low_add_to_,NAME) (struct program_state *state, \
-
TYPE ARG) { \
-
NUMTYPE m = state->malloc_size_program->PIKE_CONCAT(num_,NAME); \
-
CHECK_FOO(NUMTYPE,TYPE,NAME); \
-
DO_IF_DEBUG(if (state->compiler_pass != 1) { \
-
Pike_fatal("Adding " TOSTR(NAME) " in pass %d.\n", \
-
state->compiler_pass); \
-
}); \
-
if(m == state->new_program->PIKE_CONCAT(num_,NAME)) { \
-
TYPE *tmp; \
-
if(m==MAXVARS(NUMTYPE)) { \
-
yyerror("Too many " #NAME "."); \
-
return; \
-
} \
-
m = MINIMUM(m*2+1,MAXVARS(NUMTYPE)); \
-
tmp = realloc((void *)state->new_program->NAME, \
-
sizeof(TYPE) * m); \
-
if(!tmp) Pike_fatal("Out of memory.\n"); \
-
PIKE_CONCAT(RELOCATE_,NAME)(state->new_program, tmp); \
-
state->malloc_size_program->PIKE_CONCAT(num_,NAME)=m; \
-
state->new_program->NAME=tmp; \
-
} \
-
state->new_program-> \
-
NAME[state->new_program->PIKE_CONCAT(num_,NAME)++]=(ARG); \
-
} \
-
void PIKE_CONCAT(add_to_,NAME) (ARGTYPE ARG) { \
-
PIKE_CONCAT(low_add_to_,NAME) ( Pike_compiler, ARG ); \
-
}
-
-
-
#include "program_areas.h"
-
-
-
#define add_to_program(ARG) do { \
-
debug_malloc_touch(Pike_compiler->new_program->program); \
-
add_to_program(ARG); \
-
} while(0)
-
-
void ins_int(INT32 i, void (*func)(char tmp))
-
{
-
int e;
-
unsigned char *p = (unsigned char *)&i;
-
for(e=0;e<(long)sizeof(i);e++) {
-
func(p[e]);
-
}
-
}
-
-
void ins_short(int i, void (*func)(char tmp))
-
{
-
int e;
-
unsigned char *p = (unsigned char *)&i;
-
for(e=0;e<(long)sizeof(i);e++) {
-
func(p[e]);
-
}
-
}
-
-
#if 0
-
/* This check is not possible to do since the identifier is added
-
* before checking for duplicates in add_constant. */
-
static void debug_add_to_identifiers (struct identifier id)
-
{
-
if (d_flag) {
-
int i;
-
for (i = 0; i < Pike_compiler->new_program->num_identifiers; i++)
-
if (Pike_compiler->new_program->identifiers[i].name == id.name) {
-
dump_program_tables (Pike_compiler->new_program, 0);
-
Pike_fatal ("Adding identifier twice, old at %s:%d #%d.\n",
-
Pike_compiler->new_program->identifiers[i].filename?
-
Pike_compiler->new_program->identifiers[i].filename:"-",
-
Pike_compiler->new_program->identifiers[i].linenumber,
-
i);
-
}
-
}
-
add_to_identifiers (id);
-
}
-
#else
-
#define debug_add_to_identifiers(ARG) add_to_identifiers(ARG)
-
#endif
-
-
void add_relocated_int_to_program(INT32 i)
-
{
-
add_to_relocations(Pike_compiler->new_program->num_program);
-
ins_int(i, (void (*)(char))add_to_program);
-
}
-
-
void use_module(struct svalue *s)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
if( (1<<TYPEOF(*s)) & (BIT_MAPPING | BIT_OBJECT | BIT_PROGRAM))
-
{
-
c->num_used_modules++;
-
Pike_compiler->num_used_modules++;
-
assign_svalue_no_free((struct svalue *)
-
low_make_buf_space(sizeof(struct svalue),
-
&c->used_modules), s);
-
if(Pike_compiler->module_index_cache)
-
{
-
free_mapping(Pike_compiler->module_index_cache);
-
Pike_compiler->module_index_cache=0;
-
}
-
if(c->resolve_cache)
-
{
-
free_mapping(c->resolve_cache);
-
c->resolve_cache=0;
-
}
-
}else{
-
yyerror("Module is neither mapping nor object");
-
}
-
}
-
-
void unuse_modules(INT32 howmany)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
if(!howmany) return;
-
#ifdef PIKE_DEBUG
-
if(howmany *sizeof(struct svalue) > c->used_modules.s.len)
-
Pike_fatal("Unusing too many modules.\n");
-
#endif
-
c->num_used_modules -= howmany;
-
Pike_compiler->num_used_modules-=howmany;
-
low_make_buf_space((ptrdiff_t) sizeof(struct svalue) * -howmany,
-
&c->used_modules);
-
free_svalues((struct svalue *)low_make_buf_space(0, &c->used_modules),
-
howmany,
-
BIT_MAPPING | BIT_OBJECT | BIT_PROGRAM);
-
if(Pike_compiler->module_index_cache)
-
{
-
free_mapping(Pike_compiler->module_index_cache);
-
Pike_compiler->module_index_cache=0;
-
}
-
}
-
-
int low_find_shared_string_identifier(struct pike_string *name,
-
struct program *prog);
-
-
-
-
static struct node_s *index_modules(struct pike_string *ident,
-
struct mapping **module_index_cache,
-
int num_used_modules,
-
struct svalue *modules)
-
{
-
if(*module_index_cache)
-
{
-
struct svalue *tmp=low_mapping_string_lookup(*module_index_cache,ident);
-
if(tmp)
-
{
-
if(!(SAFE_IS_ZERO(tmp) && SUBTYPEOF(*tmp)==1))
-
return mksvaluenode(tmp);
-
return 0;
-
}
-
}
-
-
/* fprintf(stderr,"index_module: %s\n",ident->str); */
-
-
{
-
JMP_BUF tmp;
-
-
if(SETJMP(tmp))
-
handle_compile_exception ("Couldn't index a module with %S.", ident);
-
else {
-
int e = num_used_modules;
-
struct svalue *m = modules - num_used_modules;
-
-
while(--e>=0)
-
{
-
push_svalue(m+e);
-
ref_push_string(ident);
-
f_index(2);
-
-
if(!IS_UNDEFINED(Pike_sp-1))
-
{
-
struct node_s *ret;
-
UNSETJMP(tmp);
-
-
if (Pike_compiler->compiler_pass == 2 &&
-
((TYPEOF(Pike_sp[-1]) == T_OBJECT &&
-
Pike_sp[-1].u.object == placeholder_object) ||
-
(TYPEOF(Pike_sp[-1]) == T_PROGRAM &&
-
Pike_sp[-1].u.program == placeholder_program))) {
-
my_yyerror("Got placeholder %s (resolver problem) "
-
"when indexing a module with %S.",
-
get_name_of_type (TYPEOF(Pike_sp[-1])), ident);
-
ret = 0;
-
}
-
else {
-
if(!*module_index_cache)
-
*module_index_cache = allocate_mapping(10);
-
mapping_string_insert(*module_index_cache, ident, Pike_sp-1);
-
ret = mksvaluenode(Pike_sp-1);
-
#if 0 && defined (COMPILER_DEBUG)
-
safe_pike_fprintf (stderr, "Index %S: %O\n", ident, Pike_sp - 1);
-
#endif
-
}
-
pop_stack();
-
return ret;
-
}
-
pop_stack();
-
}
-
}
-
UNSETJMP(tmp);
-
}
-
-
#if 0 && defined (COMPILER_DEBUG)
-
safe_pike_fprintf (stderr, "Index %S: undefined\n", ident);
-
#endif
-
-
return 0;
-
}
-
-
struct node_s *resolve_identifier(struct pike_string *ident);
-
-
struct node_s *find_module_identifier(struct pike_string *ident,
-
int see_inherit)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct node_s *ret;
-
-
struct svalue *modules=(struct svalue *)
-
(c->used_modules.s.str + c->used_modules.s.len);
-
-
{
-
struct program_state *p=Pike_compiler;
-
int n;
-
for(n=0;n<=c->compilation_depth;n++,p=p->previous)
-
{
-
int i;
-
if(see_inherit)
-
{
-
i=really_low_find_shared_string_identifier(ident,
-
p->new_program,
-
SEE_PROTECTED|SEE_PRIVATE);
-
if(i!=-1)
-
{
-
if ((p->flags & COMPILATION_FORCE_RESOLVE) &&
-
(p->compiler_pass == 2) &&
-
((p->num_inherits + 1) < p->new_program->num_inherits) &&
-
(PTR_FROM_INT(p->new_program, i)->inherit_offset >
-
p->num_inherits)) {
-
/* Don't look up symbols inherited later, since we need to get
-
* the same symbol in both passes in the force_resolve mode.
-
*/
-
continue;
-
}
-
return p == Pike_compiler ?
-
mkidentifiernode(i) :
-
mkexternalnode(p->new_program, i);
-
}
-
}
-
-
if((ret=index_modules(ident,
-
&p->module_index_cache,
-
p->num_used_modules,
-
modules))) return ret;
-
modules-=p->num_used_modules;
-
#ifdef PIKE_DEBUG
-
if( ((char *)modules ) < c->used_modules.s.str)
-
Pike_fatal("Modules out of whack!\n");
-
#endif
-
}
-
}
-
-
return resolve_identifier(ident);
-
}
-
-
/*! @decl constant UNDEFINED
-
*!
-
*! The undefined value; ie a zero for which @[zero_type()] returns 1.
-
*/
-
-
struct node_s *resolve_identifier(struct pike_string *ident)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
node *ret = NULL;
-
-
/* Handle UNDEFINED */
-
if (ident == UNDEFINED_string) {
-
return mkconstantsvaluenode(&svalue_undefined);
-
}
-
-
if(c->resolve_cache)
-
{
-
struct svalue *tmp=low_mapping_string_lookup(c->resolve_cache,ident);
-
if(tmp)
-
{
-
if(!IS_UNDEFINED (tmp))
-
return mkconstantsvaluenode(tmp);
-
-
return 0;
-
}
-
}
-
-
CHECK_COMPILER();
-
-
ref_push_string(ident);
-
ref_push_string(c->lex.current_file);
-
if (c->handler) {
-
ref_push_object(c->handler);
-
} else {
-
push_int(0);
-
}
-
if (!safe_apply_current2(PC_RESOLV_FUN_NUM, 3, NULL))
-
handle_compile_exception ("Error resolving '%S'.", ident);
-
-
if (Pike_compiler->compiler_pass != 2) {
-
/* If we get a program that hasn't gone through pass 1 yet then we
-
* have to register a dependency now in our pass 1 so that our
-
* pass 2 gets delayed. Otherwise the other program might still be
-
* just as unfinished when we come back here in pass 2. */
-
struct program *p = NULL;
-
if (TYPEOF(Pike_sp[-1]) == T_PROGRAM)
-
p = Pike_sp[-1].u.program;
-
else if (TYPEOF(Pike_sp[-1]) == T_OBJECT ||
-
(TYPEOF(Pike_sp[-1]) == T_FUNCTION &&
-
SUBTYPEOF(Pike_sp[-1]) != FUNCTION_BUILTIN))
-
p = Pike_sp[-1].u.object->prog;
-
if (p && !(p->flags & PROGRAM_PASS_1_DONE))
-
report_compiler_dependency (p);
-
}
-
-
if (Pike_compiler->compiler_pass == 2 &&
-
((TYPEOF(Pike_sp[-1]) == T_OBJECT &&
-
Pike_sp[-1].u.object == placeholder_object) ||
-
(TYPEOF(Pike_sp[-1]) == T_PROGRAM &&
-
Pike_sp[-1].u.program == placeholder_program))) {
-
my_yyerror("Got placeholder %s (resolver problem) "
-
"when resolving '%S'.",
-
get_name_of_type (TYPEOF(Pike_sp[-1])), ident);
-
} else {
-
if(!c->resolve_cache)
-
c->resolve_cache=dmalloc_touch(struct mapping *, allocate_mapping(10));
-
mapping_string_insert(c->resolve_cache,ident,Pike_sp-1);
-
-
if(!IS_UNDEFINED (Pike_sp-1))
-
{
-
ret=mkconstantsvaluenode(Pike_sp-1);
-
}
-
}
-
pop_stack();
-
-
return ret;
-
}
-
-
/* This function is intended to simplify resolving of
-
* program symbols during compile-time for C-modules.
-
*
-
* A typical use-case is for a C-module inheriting
-
* code written in Pike.
-
*/
-
PMOD_EXPORT struct program *resolve_program(struct pike_string *ident)
-
{
-
struct program *ret = NULL;
-
struct node_s *n = resolve_identifier(ident);
-
if (n) {
-
if ((n->token == F_CONSTANT) && (TYPEOF(n->u.sval) == T_PROGRAM) &&
-
(ret = n->u.sval.u.program)) {
-
add_ref(ret);
-
} else {
-
my_yyerror("Invalid program identifier '%S'.", ident);
-
}
-
free_node(n);
-
} else {
-
my_yyerror("Unknown program identifier '%S'.", ident);
-
}
-
return ret;
-
}
-
-
/*! @decl constant this
-
*!
-
*! Builtin read only variable that evaluates to the current object.
-
*!
-
*! @seealso
-
*! @[this_program], @[this_object()]
-
*/
-
-
/*! @decl constant this_program
-
*!
-
*! Builtin constant that evaluates to the current program.
-
*!
-
*! @seealso
-
*! @[this], @[this_object()]
-
*/
-
-
/* If the identifier is recognized as one of the magic identifiers,
-
* like "this", "this_program" or "`->" when preceded by ::, then a
-
* suitable node is returned, NULL otherwise.
-
*
-
* inherit_num is -1 when no specific inherit has been specified; ie
-
* either when the identifier has no prefix (colon_colon_ref == 0) or
-
* when the identifier has the prefix :: without any preceding identifier
-
* (colon_colon_ref == 1).
-
*
-
* New in Pike 7.9.5 and later:
-
*
-
* If colon_colon_ref is 1 and the selected inherit defines the
-
* `->() lfun, code calling the lfun will be generated as follows:
-
*
-
* inh::`->(ident, inh::this, 1)
-
*/
-
struct node_s *program_magic_identifier (struct program_state *state,
-
int state_depth, int inherit_num,
-
struct pike_string *ident,
-
int colon_colon_ref)
-
{
-
#if 0
-
fprintf (stderr, "magic_identifier (state, %d, %d, %s, %d)\n",
-
state_depth, inherit_num, ident->str, colon_colon_ref);
-
#endif
-
-
if (!inherit_num && TEST_COMPAT(7,6)) {
-
/* Pike 7.6 and earlier couldn't refer to the current inherit. */
-
inherit_num = -1;
-
}
-
-
if ((inherit_num == -1) || (!TEST_COMPAT(7,6) && (inherit_num >= 0))) {
-
if (ident == this_string) {
-
/* Handle this. */
-
return mkthisnode(state->new_program, inherit_num);
-
}
-
-
/* Handle this_program */
-
if (ident == this_program_string) {
-
node *n;
-
if (!state_depth && (inherit_num == -1) && colon_colon_ref &&
-
!TEST_COMPAT(7,8) &&
-
state->previous && state->previous->new_program) {
-
/* ::this_program
-
*
-
* This refers to the previous definition of the current class
-
* in its parent, and is typically used with inherit like:
-
*
-
* inherit Foo;
-
*
-
* // Override the Bar inherited from Foo.
-
* class Bar {
-
* // Bar is based on the implementation from Foo.
-
* inherit ::this_program;
-
*
-
* // ...
-
* }
-
*/
-
struct program *parent;
-
struct pike_string *name = NULL;
-
int e;
-
int i;
-
-
/* Find the name of the current class. */
-
parent = state->previous->new_program;
-
for (e = parent->num_identifier_references; e--;) {
-
struct identifier *id = ID_FROM_INT(parent, e);
-
struct svalue *s;
-
if (!IDENTIFIER_IS_CONSTANT(id->identifier_flags) ||
-
(id->func.const_info.offset < 0)) {
-
continue;
-
}
-
s = &PROG_FROM_INT(parent, e)->
-
constants[id->func.const_info.offset].sval;
-
if ((TYPEOF(*s) != T_PROGRAM) ||
-
(s->u.program != state->new_program)) {
-
continue;
-
}
-
/* Found! */
-
name = id->name;
-
break;
-
}
-
if (!name) {
-
yyerror("Failed to find current class in its parent.");
-
return NULL;
-
}
-
-
/* Find ::name in the parent. */
-
i = reference_inherited_identifier(state->previous, NULL, name);
-
if (i == -1) {
-
my_yyerror("Failed to find previous inherited definition of %S "
-
"in parent.", name);
-
return NULL;
-
}
-
n = mkexternalnode(parent, i);
-
} else {
-
n = mkefuncallnode("object_program",
-
mkthisnode(state->new_program, inherit_num));
-
}
-
/* We know this expression is constant. */
-
n->node_info &= ~OPT_NOT_CONST;
-
n->tree_info &= ~OPT_NOT_CONST;
-
return n;
-
}
-
-
/* Handle this_function */
-
if (ident == this_function_string) {
-
int i;
-
if ((i = Pike_compiler->compiler_frame->current_function_number) >= 0) {
-
struct identifier *id;
-
id = ID_FROM_INT(Pike_compiler->new_program, i);
-
if (id->identifier_flags & IDENTIFIER_SCOPED) {
-
return mktrampolinenode(i, Pike_compiler->compiler_frame->previous);
-
} else {
-
return mkidentifiernode(i);
-
}
-
} else {
-
/* FIXME: Fall back to __INIT? */
-
}
-
}
-
}
-
-
if (colon_colon_ref) {
-
int i = inherit_num;
-
-
/* These are only recognized when prefixed with the :: operator. */
-
-
if (inherit_num < 0) i = 0;
-
if(ident == lfun_strings[LFUN_ARROW] ||
-
ident == lfun_strings[LFUN_INDEX]) {
-
return mknode(F_MAGIC_INDEX, mknewintnode(i),
-
mknewintnode(state_depth));
-
} else if(ident == lfun_strings[LFUN_ASSIGN_ARROW] ||
-
ident == lfun_strings[LFUN_ASSIGN_INDEX]) {
-
return mknode(F_MAGIC_SET_INDEX, mknewintnode(i),
-
mknewintnode(state_depth));
-
} else if(ident == lfun_strings[LFUN__INDICES]) {
-
return mknode(F_MAGIC_INDICES, mknewintnode(i),
-
mknewintnode(state_depth));
-
} else if(ident == lfun_strings[LFUN__VALUES]) {
-
return mknode(F_MAGIC_VALUES, mknewintnode(i),
-
mknewintnode(state_depth));
-
} else if(ident == lfun_strings[LFUN__TYPES]) {
-
return mknode(F_MAGIC_TYPES, mknewintnode(i),
-
mknewintnode(state_depth));
-
}
-
-
if (inherit_num && !TEST_COMPAT(7, 8) &&
-
(state->new_program->num_inherits > 1)) {
-
/* Check if there's an inherited lfun::`->() that we can call. */
-
int id;
-
struct program *prog = state->new_program->inherits[i].prog;
-
if (((id = FIND_LFUN(prog, LFUN_ARROW)) == -1) &&
-
(prog == state->new_program)) {
-
/* We are allowed to see private symbols in ourselves... */
-
id = really_low_find_shared_string_identifier(lfun_strings[LFUN_ARROW],
-
prog,
-
SEE_PROTECTED|SEE_PRIVATE);
-
} else if ((id != -1) && (prog != state->new_program)) {
-
id = really_low_reference_inherited_identifier(state, i, id);
-
}
-
if ((id != -1) && (state->compiler_pass == 2)) {
-
if (inherit_num < 0) {
-
/* Find the closest inherit containing the lfun::`->()
-
* that is about to be called.
-
*
-
* In the single inherit case, this will always
-
* result in inherit_num == 1.
-
*/
-
struct inherit *inherits = state->new_program->inherits;
-
inherit_num = PTR_FROM_INT(state->new_program, id)->inherit_offset;
-
while (inherits[inherit_num].inherit_level > 1) {
-
inherit_num--;
-
}
-
}
-
return mknode(F_APPLY, mkexternalnode(state->new_program, id),
-
mknode(F_ARG_LIST,
-
mkstrnode(ident),
-
mknode(F_ARG_LIST,
-
mkthisnode(state->new_program, inherit_num),
-
mkintnode(1))));
-
}
-
}
-
}
-
-
return NULL;
-
}
-
-
/* Fixme: allow level=0 to return the current level */
-
struct program *parent_compilation(int level)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
int n;
-
struct program_state *p=Pike_compiler->previous;
-
for(n=0;n<level;n++)
-
{
-
if(n>=c->compilation_depth) return 0;
-
p=p->previous;
-
if(!p) return 0;
-
}
-
return p->new_program;
-
}
-
-
#define ID_TO_PROGRAM_CACHE_SIZE 512
-
struct program *id_to_program_cache[ID_TO_PROGRAM_CACHE_SIZE];
-
-
struct program *id_to_program(INT32 id)
-
{
-
struct program_state *state;
-
struct program *p;
-
INT32 h;
-
if(!id) return 0;
-
-
/* fprintf(stderr, "id_to_program(%d)... ", id); */
-
-
h=id & (ID_TO_PROGRAM_CACHE_SIZE-1);
-
-
if((p=id_to_program_cache[h]))
-
if(p->id==id) {
-
/* fprintf(stderr, "cached: %p\n", p); */
-
return p;
-
}
-
-
for(p=first_program;p;p=p->next)
-
{
-
if(id==p->id)
-
{
-
id_to_program_cache[h]=p;
-
/* fprintf(stderr, "found: %p\n", p); */
-
return p;
-
}
-
}
-
-
/* Check if it is a program being compiled right now. */
-
for (state = Pike_compiler; state; state = state->previous) {
-
if (state->new_program && state->new_program->id == id) {
-
return state->new_program;
-
}
-
}
-
-
if ((id > 0) && (id < PROG_DYNAMIC_ID_START)) {
-
/* Reserved id. Attempt to load the proper dynamic module
-
* to resolv the id.
-
*/
-
char *module = NULL;
-
-
/* fprintf(stderr, "reserved "); */
-
-
switch(id) {
-
case PROG_PARSER_HTML_ID:
-
module = "Parser._parser";
-
break;
-
case PROG_GMP_MPZ_ID:
-
module = "Gmp";
-
break;
-
case PROG_MODULE_MIME_ID:
-
module = "___MIME";
-
break;
-
default:
-
if ((id >= 100) && (id <= 300)) {
-
module = "Image";
-
} else if ((id >= 1000) && (id < 2000)) {
-
module = "___GTK";
-
} else if ((id >= 2000) && (id < 3000)) {
-
module = "___GTK2";
-
}
-
break;
-
}
-
if (module && get_master()) {
-
/* fprintf(stderr, "%s... ", module); */
-
push_text(module);
-
SAFE_APPLY_MASTER("resolv", 1);
-
pop_stack();
-
-
/* Try again... */
-
for(p=first_program;p;p=p->next)
-
{
-
if(id==p->id)
-
{
-
id_to_program_cache[h]=p;
-
/* fprintf(stderr, "found: %p\n", p); */
-
return p;
-
}
-
}
-
}
-
}
-
/* fprintf(stderr, "not found\n"); */
-
return 0;
-
}
-
-
/* Here starts routines which are used to build new programs */
-
-
/*
-
* A typical program goes through the following steps:
-
*
-
* allocate_program ==> PROGRAM_VIRGIN
-
*
-
* start_program ==> !PROGRAM_VIRGIN
-
*
-
* end_first_pass ==> PROGRAM_PASS_1_DONE
-
*
-
* fixate_program ==> PROGRAM_FIXED
-
*
-
* optimize_program ==> PROGRAM_OPTIMIZED
-
*
-
* end_first_pass(1) ==> PROGRAM_FINISHED
-
*/
-
-
/* Re-allocate all the memory in the program in one chunk. because:
-
* 1) The individual blocks are much bigger than they need to be
-
* 2) cuts down on malloc overhead (maybe)
-
* 3) localizes memory access (decreases paging)
-
*/
-
void optimize_program(struct program *p)
-
{
-
size_t size=0;
-
char *data;
-
-
/* Already done (shouldn't happen, but who knows?) */
-
if(p->flags & PROGRAM_OPTIMIZED) return;
-
-
#ifdef PIKE_USE_MACHINE_CODE
-
/* Don't move our mexec-allocated memory into the malloc... */
-
#define BAR(NUMTYPE,TYPE,ARGTYPE,NAME)
-
#endif /* PIKE_USE_MACHINE_CODE */
-
-
#define FOO(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
size=DO_ALIGN(size, ALIGNOF(TYPE)); \
-
size+=p->PIKE_CONCAT(num_,NAME)*sizeof(p->NAME[0]);
-
#include "program_areas.h"
-
-
data=malloc(size);
-
if(!data)
-
{
-
make_program_executable(p);
-
return; /* We are out of memory, but we don't care! */
-
}
-
-
size=0;
-
-
#ifdef PIKE_USE_MACHINE_CODE
-
/* As above. */
-
#define BAR(NUMTYPE,TYPE,ARGTYPE,NAME)
-
#endif /* PIKE_USE_MACHINE_CODE */
-
-
#define FOO(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
size=DO_ALIGN(size, ALIGNOF(TYPE)); \
-
if (p->PIKE_CONCAT (num_, NAME)) \
-
MEMCPY(data+size,p->NAME,p->PIKE_CONCAT(num_,NAME)*sizeof(p->NAME[0])); \
-
PIKE_CONCAT(RELOCATE_,NAME)(p, (TYPE *)(data+size)); \
-
dmfree(p->NAME); \
-
p->NAME=(TYPE *)(data+size); \
-
size+=p->PIKE_CONCAT(num_,NAME)*sizeof(p->NAME[0]);
-
#include "program_areas.h"
-
-
p->total_size=size + sizeof(struct program);
-
-
p->flags |= PROGRAM_OPTIMIZED;
-
make_program_executable(p);
-
}
-
-
/* internal function to make the index-table */
-
static int program_identifier_index_compare(int a, int b,
-
const struct program *p)
-
{
-
size_t val_a = PTR_TO_INT (ID_FROM_INT(p, a)->name);
-
size_t val_b = PTR_TO_INT (ID_FROM_INT(p, b)->name);
-
return val_a < val_b ? -1 : (val_a == val_b ? (a < b? -1:(a != b)) : 1);
-
}
-
-
#define CMP(X,Y) program_identifier_index_compare(*(X), *(Y), prog)
-
#define EXTRA_ARGS , struct program *prog
-
#define XARGS , prog
-
#define ID fsort_program_identifier_index
-
#define TYPE unsigned short
-
#include "fsort_template.h"
-
#undef TYPE
-
#undef ID
-
#undef XARGS
-
#undef EXTRA_ARGS
-
#undef CMP
-
-
#ifdef PIKE_DEBUG
-
struct pike_string *find_program_name(struct program *p, INT_TYPE *line)
-
{
-
INT_TYPE l;
-
if(!line) line=&l;
-
-
#ifdef DEBUG_MALLOC
-
{
-
char *tmp=dmalloc_find_name(p);
-
if (tmp) {
-
char *p = STRCHR (tmp, ':');
-
if (p) {
-
char *pp;
-
while ((pp = STRCHR (p + 1, ':'))) p = pp;
-
*line = atoi (p + 1);
-
return make_shared_binary_string (tmp, p - tmp);
-
}
-
else {
-
*line=0;
-
return make_shared_string(tmp);
-
}
-
}
-
}
-
#endif
-
-
return get_program_line(p, line);
-
}
-
#endif
-
-
int override_identifier (struct reference *new_ref, struct pike_string *name)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
int id = -1, cur_id = 0, is_used = 0;
-
-
int new_is_variable =
-
IDENTIFIER_IS_VARIABLE(ID_FROM_PTR(Pike_compiler->new_program,
-
new_ref)->identifier_flags);
-
-
/* This loop could possibly be optimized by looping over
-
* each inherit and looking up 'name' in each inherit
-
* and then see if should be overwritten
-
* /Hubbe
-
*/
-
-
CHECK_COMPILER();
-
-
for(;cur_id<Pike_compiler->new_program->num_identifier_references;cur_id++)
-
{
-
struct reference *ref =
-
Pike_compiler->new_program->identifier_references + cur_id;
-
struct identifier *i;
-
-
/* No need to do anything for ourselves. */
-
if (ref == new_ref) continue;
-
-
/* Do not zapp hidden identifiers */
-
if(ref->id_flags & ID_HIDDEN) continue;
-
-
if(ref->id_flags & ID_VARIANT) continue;
-
-
/* Do not zapp functions with the wrong name... */
-
if((i = ID_FROM_PTR(Pike_compiler->new_program, ref))->name != name)
-
continue;
-
-
/* Do not zapp inherited inline ('local') identifiers,
-
* or inherited externals with new externals,
-
* since this makes it hard to identify in encode_value().
-
*/
-
if((ref->id_flags & (ID_INLINE|ID_INHERITED)) == (ID_INLINE|ID_INHERITED)
-
|| (ref->id_flags & new_ref->id_flags & ID_EXTERN)) {
-
/* But we still need to hide them, since we shadow them... */
-
ref->id_flags |= ID_HIDDEN;
-
continue;
-
}
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
fprintf(stderr, "%.*soverloaded reference %d (id_flags:0x%04x)\n",
-
c->compilation_depth, "", cur_id, ref->id_flags);
-
#endif
-
-
if (!new_is_variable && IDENTIFIER_IS_VARIABLE(i->identifier_flags)) {
-
/* Overloading a variable with a constant or a function.
-
* This is generally a bad idea.
-
*/
-
ref->id_flags |= ID_INLINE|ID_HIDDEN;
-
yywarning("Attempt to override a non local variable %S "
-
"with a non-variable.", name);
-
continue;
-
}
-
-
if ((ref->id_flags & (ID_INHERITED|ID_USED)) == (ID_INHERITED|ID_USED)) {
-
struct inherit *inh = INHERIT_FROM_PTR(Pike_compiler->new_program, ref);
-
struct reference *sub_ref;
-
-
/* Find the inherit one level away. */
-
while (inh->inherit_level > 1) inh--;
-
-
#ifdef PIKE_DEBUG
-
if (!inh->inherit_level) {
-
Pike_fatal("Inherit without intermediate levels.\n");
-
}
-
#endif
-
-
sub_ref = PTR_FROM_INT(inh->prog, cur_id - inh->identifier_level);
-
-
/* Check if the symbol was used before it was inherited. */
-
if ((c->lex.pragmas & ID_STRICT_TYPES) &&
-
(sub_ref->id_flags & ID_USED)) {
-
struct identifier *sub_id = ID_FROM_PTR(inh->prog, sub_ref);
-
if (IDENTIFIER_IS_FUNCTION(sub_id->identifier_flags)) {
-
if ((Pike_compiler->compiler_pass == 2) &&
-
!pike_types_le(ID_FROM_PTR(Pike_compiler->new_program,
-
new_ref)->type, sub_id->type)) {
-
yytype_report(REPORT_WARNING,
-
NULL, 0, sub_id->type,
-
NULL, 0, ID_FROM_PTR(Pike_compiler->new_program,
-
new_ref)->type,
-
0, "Type mismatch when overloading function %S.",
-
name);
-
}
-
} else {
-
struct identifier *new_id;
-
/* Variable or constant.
-
*
-
* Note: Use weaker check for integers (especially for constants).
-
*/
-
if (!pike_types_le(sub_id->type,
-
(new_id = ID_FROM_PTR(Pike_compiler->new_program,
-
new_ref))->type) &&
-
!((i->run_time_type == PIKE_T_INT) &&
-
(new_id->run_time_type == PIKE_T_INT) &&
-
(IDENTIFIER_IS_CONSTANT(sub_id->identifier_flags) ||
-
match_types(sub_id->type, new_id->type)))) {
-
yytype_report(REPORT_WARNING,
-
NULL, 0, sub_id->type,
-
NULL, 0, new_id->type,
-
0, "Type mismatch when overloading %S.", name);
-
}
-
}
-
}
-
}
-
is_used = ref->id_flags & ID_USED;
-
-
*ref=*new_ref;
-
ref->id_flags |= is_used;
-
id = cur_id;
-
}
-
-
return id;
-
}
-
-
void fixate_program(void)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
INT32 i,e,t;
-
struct program *p=Pike_compiler->new_program;
-
-
CHECK_COMPILER();
-
-
if(p->flags & PROGRAM_FIXED) return;
-
#ifdef PIKE_DEBUG
-
if(p->flags & PROGRAM_OPTIMIZED)
-
Pike_fatal("Cannot fixate optimized program\n");
-
#endif
-
-
/* Fixup the runtime type for functions.
-
* (T_MIXED is used as the tentative type marker in pass 1).
-
*/
-
for (i=0; i < p->num_identifiers; i++) {
-
if (IDENTIFIER_IS_FUNCTION(p->identifiers[i].identifier_flags) &&
-
(p->identifiers[i].run_time_type == T_MIXED)) {
-
/* Get rid of the remaining tentative type marker. */
-
/* FIXME: Should probably never be reachable.
-
* Consider this a fatal?
-
*/
-
p->identifiers[i].run_time_type = T_FUNCTION;
-
}
-
}
-
-
/* Fixup identifier overrides. */
-
for (i = 0; i < p->num_identifier_references; i++) {
-
struct reference *ref = p->identifier_references + i;
-
if (ref->id_flags & ID_HIDDEN) continue;
-
if (ref->id_flags & ID_VARIANT) continue;
-
if (ref->inherit_offset != 0) continue;
-
override_identifier (ref, ID_FROM_PTR (p, ref)->name);
-
}
-
-
/* Ok, sort for binsearch */
-
for(e=i=0;i<(int)p->num_identifier_references;i++)
-
{
-
struct reference *funp;
-
struct identifier *fun;
-
funp=p->identifier_references+i;
-
if(funp->id_flags & ID_HIDDEN) continue;
-
if(funp->id_flags & ID_VARIANT) continue;
-
fun=ID_FROM_PTR(p, funp);
-
if(funp->id_flags & ID_INHERITED)
-
{
-
int found_better=-1;
-
int funa_is_prototype;
-
-
/* NOTE: Mixin is currently not supported for PRIVATE symbols. */
-
if(funp->id_flags & ID_PRIVATE) continue;
-
funa_is_prototype = fun->func.offset == -1;
-
/* if(fun->func.offset == -1) continue; * prototype */
-
-
/* check for multiple definitions */
-
for(t=i+1;t<(int)p->num_identifier_references;t++)
-
{
-
struct reference *funpb;
-
struct identifier *funb;
-
-
funpb=p->identifier_references+t;
-
if (funpb->id_flags & ID_HIDDEN) continue;
-
if (funpb->id_flags & ID_VARIANT) continue;
-
funb=ID_FROM_PTR(p,funpb);
-
/* if(funb->func.offset == -1) continue; * prototype */
-
-
if(fun->name==funb->name)
-
{
-
if (!(funpb->id_flags & ID_PROTECTED)) {
-
/* Only regard this symbol as better if it
-
* will end up in the index further below.
-
*/
-
found_better=t;
-
}
-
-
/* FIXME: Is this stuff needed?
-
* It looks like it already is done by define_function().
-
*
-
* Yes -- It's needed in case of mixin.
-
*/
-
if(funa_is_prototype && (funb->func.offset != -1) &&
-
!(funp->id_flags & ID_INLINE))
-
{
-
if ((c->lex.pragmas & ID_STRICT_TYPES) &&
-
(funp->id_flags & ID_USED)) {
-
/* Verify that the types are compatible. */
-
if (!pike_types_le(funb->type, fun->type)) {
-
yytype_report(REPORT_WARNING, NULL, 0, fun->type,
-
NULL, 0, funb->type,
-
0, "Type mismatch when overloading %S.",
-
fun->name);
-
}
-
}
-
funp->inherit_offset = funpb->inherit_offset;
-
funp->identifier_offset = funpb->identifier_offset;
-
}
-
if(!funa_is_prototype && funb->func.offset == -1)
-
{
-
if ((c->lex.pragmas & ID_STRICT_TYPES) &&
-
(funpb->id_flags & ID_USED)) {
-
/* Verify that the types are compatible. */
-
if (!pike_types_le(fun->type, funb->type)) {
-
yytype_report(REPORT_WARNING, NULL, 0, funb->type,
-
NULL, 0, fun->type,
-
0, "Type mismatch when overloading %S.",
-
fun->name);
-
}
-
}
-
funpb->inherit_offset = funp->inherit_offset;
-
funpb->identifier_offset = funp->identifier_offset;
-
}
-
}
-
}
-
if(found_better!=-1)
-
continue;
-
}
-
if (IDENTIFIER_IS_PIKE_FUNCTION(fun->identifier_flags) &&
-
(fun->func.offset == -1) && (funp->id_flags & ID_INLINE)) {
-
my_yyerror("Missing definition for local function %S.",
-
fun->name);
-
}
-
if (funp->id_flags & ID_PROTECTED) continue;
-
add_to_identifier_index(i);
-
}
-
fsort_program_identifier_index(p->identifier_index,
-
p->identifier_index +
-
p->num_identifier_index - 1,
-
p);
-
-
/* Take care of duplicates in the identifier index table;
-
* this can happen eg when the overloading definition is
-
* before an inherit being overloaded. This happens for
-
* eg the default master object.
-
*/
-
if (p->num_identifier_index) {
-
struct identifier *id = ID_FROM_INT(p, p->identifier_index[0]);
-
for (e = i = 1; e < p->num_identifier_index; e++) {
-
struct identifier *probe = ID_FROM_INT(p, p->identifier_index[e]);
-
if (probe == id) {
-
/* Duplicate. */
-
continue;
-
}
-
p->identifier_index[i++] = p->identifier_index[e];
-
id = probe;
-
}
-
p->num_identifier_index = i;
-
}
-
-
p->flags |= PROGRAM_FIXED;
-
-
/* Yes, it is supposed to start at 1 /Hubbe */
-
for(i=1;i<NUM_LFUNS;i++) {
-
int id = p->lfuns[i] = low_find_lfun(p, i);
-
if (id >= 0) {
-
// LFUNs are used.
-
p->identifier_references[id].id_flags |= ID_USED;
-
}
-
}
-
-
/* Complain about unused private symbols. */
-
for (i = 0; i < p->num_identifier_references; i++) {
-
struct reference *ref = p->identifier_references + i;
-
if (ref->id_flags & ID_HIDDEN) continue;
-
if (ref->id_flags & ID_VARIANT) continue;
-
if (ref->inherit_offset != 0) continue;
-
-
if ((ref->id_flags & (ID_HIDDEN|ID_PRIVATE|ID_USED)) == ID_PRIVATE) {
-
yywarning("%S is private but not used anywhere.",
-
ID_FROM_PTR(p, ref)->name);
-
}
-
}
-
-
/* Set the PROGRAM_LIVE_OBJ flag by looking for destroy() and
-
* inherited PROGRAM_LIVE_OBJ flags. This is done at fixation time
-
* to allow the user to set and clear that flag while the program is
-
* being built. */
-
if (!(p->flags & PROGRAM_LIVE_OBJ)) {
-
int e, destroy = p->lfuns[LFUN_DESTROY];
-
if (destroy > -1) {
-
struct identifier *id = ID_FROM_INT (p, destroy);
-
if (!IDENTIFIER_IS_PIKE_FUNCTION (id->identifier_flags) ||
-
id->func.offset != -1) {
-
/* Got a destroy function that isn't a prototype. */
-
p->flags |= PROGRAM_LIVE_OBJ;
-
goto program_live_obj_set;
-
}
-
}
-
-
for (e = p->num_inherits - 1; e >= 0; e--)
-
if (p->inherits[e].prog->flags & PROGRAM_LIVE_OBJ) {
-
p->flags |= PROGRAM_LIVE_OBJ;
-
break;
-
}
-
-
program_live_obj_set:;
-
}
-
-
if(Pike_compiler->flags & COMPILATION_CHECK_FINAL)
-
{
-
for(i=0;i<(int)p->num_identifier_references;i++)
-
{
-
if((p->identifier_references[i].id_flags & (ID_FINAL|ID_HIDDEN)) ==
-
ID_FINAL)
-
{
-
struct pike_string *name=ID_FROM_INT(p, i)->name;
-
-
e=find_shared_string_identifier(name,p);
-
if(e == -1)
-
e=really_low_find_shared_string_identifier(name, p,
-
SEE_PROTECTED|SEE_PRIVATE);
-
-
if((e != i) && (e != -1))
-
{
-
my_yyerror("Illegal to redefine final identifier %S", name);
-
}
-
}
-
}
-
}
-
-
#ifdef DEBUG_MALLOC
-
{
-
#define DBSTR(X) ((X)?(X)->str:"")
-
int e,v;
-
INT_TYPE line;
-
struct pike_string *tmp;
-
struct memory_map *m=0;;
-
if(c->lex.current_file &&
-
c->lex.current_file->str &&
-
c->lex.current_file->len &&
-
!strcmp(c->lex.current_file->str,"-"))
-
{
-
m=dmalloc_alloc_mmap( DBSTR(c->lex.current_file), c->lex.current_line);
-
}
-
else if( (tmp=find_program_name(Pike_compiler->new_program, &line)) )
-
{
-
m=dmalloc_alloc_mmap( tmp->str, line);
-
free_string(tmp);
-
}else{
-
m=dmalloc_alloc_mmap( "program id", Pike_compiler->new_program->id);
-
}
-
-
for(e=0;e<Pike_compiler->new_program->num_inherits;e++)
-
{
-
struct inherit *i=Pike_compiler->new_program->inherits+e;
-
char *tmp;
-
struct pike_string *tmp2 = NULL;
-
char buffer[50];
-
-
for(v=0;v<i->prog->num_variable_index;v++)
-
{
-
int d=i->prog->variable_index[v];
-
struct identifier *id=i->prog->identifiers+d;
-
-
dmalloc_add_mmap_entry(m,
-
id->name->str,
-
/* OFFSETOF(object,storage) + */ i->storage_offset + id->func.offset,
-
sizeof_variable(id->run_time_type),
-
1, /* count */
-
0,0);
-
}
-
-
if(i->name)
-
{
-
tmp=i->name->str;
-
}
-
else if(!(tmp2 = find_program_name(i->prog, &line)))
-
{
-
sprintf(buffer,"inherit[%d]",e);
-
tmp=buffer;
-
} else {
-
tmp = tmp2->str;
-
}
-
dmalloc_add_mmap_entry(m,
-
tmp,
-
/* OFFSETOF(object, storage) + */ i->storage_offset,
-
i->prog->storage_needed - i->prog->inherits[0].storage_offset,
-
1, /* count */
-
0,0);
-
if (tmp2) {
-
free_string(tmp2);
-
}
-
}
-
dmalloc_set_mmap_template(Pike_compiler->new_program, m);
-
}
-
#endif
-
}
-
-
struct program *low_allocate_program(void)
-
{
-
struct program *p=alloc_program();
-
MEMSET(p, 0, sizeof(struct program));
-
p->flags|=PROGRAM_VIRGIN;
-
p->alignment_needed=1;
-
-
GC_ALLOC(p);
-
p->id=++current_program_id;
-
INIT_PIKE_MEMOBJ(p, T_PROGRAM);
-
-
DOUBLELINK(first_program, p);
-
ACCURATE_GETTIMEOFDAY(& p->timestamp);
-
return p;
-
}
-
-
/*
-
* Start building a new program
-
*/
-
void low_start_new_program(struct program *p,
-
int pass,
-
struct pike_string *name,
-
int flags,
-
int *idp)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
int id=0;
-
struct svalue tmp;
-
-
CHECK_COMPILER();
-
-
#ifdef WITH_FACETS
-
if(Pike_compiler->compiler_pass == 1 && p) {
-
p->facet_index = -1;
-
p->facet_group = NULL;
-
}
-
#endif
-
-
/* We don't want to change thread, but we don't want to
-
* wait for the other threads to complete either.
-
*/
-
low_init_threads_disable();
-
-
c->compilation_depth++;
-
-
if (!Pike_compiler->compiler_frame) {
-
new_node_s_context();
-
}
-
-
SET_SVAL_TYPE(tmp, T_PROGRAM);
-
if(!p)
-
{
-
p=low_allocate_program();
-
if(name)
-
{
-
tmp.u.program=p;
-
id=add_constant(name, &tmp, flags & ~ID_EXTERN);
-
#if 0
-
fprintf(stderr,"Compiling class %s, depth=%d\n",
-
name->str, c->compilation_depth);
-
}else{
-
fprintf(stderr,"Compiling file %s, depth=%d\n",
-
c->lex.current_file ? c->lex.current_file->str : "-",
-
c->compilation_depth);
-
#endif
-
}
-
}else{
-
tmp.u.program=p;
-
add_ref(p);
-
if((pass == 2) && name)
-
{
-
struct identifier *i;
-
id=isidentifier(name);
-
if (id < 0)
-
Pike_fatal("Program constant disappeared in second pass.\n");
-
i=ID_FROM_INT(Pike_compiler->new_program, id);
-
free_type(i->type);
-
i->type=get_type_of_svalue(&tmp);
-
}
-
}
-
if (pass == 1) {
-
if(c->compilation_depth >= 1) {
-
add_ref(p->parent = Pike_compiler->new_program);
-
debug_malloc_touch (p);
-
}
-
}
-
p->flags &=~ PROGRAM_VIRGIN;
-
if(idp) *idp=id;
-
-
CDFPRINTF((stderr, "th(%ld) %p low_start_new_program() %s "
-
"pass=%d: threads_disabled:%d, compilation_depth:%d\n",
-
(long)th_self(), p, name ? name->str : "-",
-
Pike_compiler->compiler_pass,
-
threads_disabled, c->compilation_depth));
-
-
init_type_stack();
-
-
#define PUSH
-
#include "compilation.h"
-
-
Pike_compiler->parent_identifier=id;
-
Pike_compiler->compiler_pass = pass;
-
-
Pike_compiler->num_used_modules=0; /* FIXME: Duplicate? */
-
-
if(p->flags & PROGRAM_FINISHED)
-
{
-
yyerror("Pass2: Program already done");
-
}
-
-
Pike_compiler->malloc_size_program = ALLOC_STRUCT(program);
-
Pike_compiler->fake_object=alloc_object();
-
-
#ifdef PIKE_DEBUG
-
Pike_compiler->fake_object->storage=(char *)malloc(256 * sizeof(struct svalue));
-
if (Pike_compiler->fake_object->storage) {
-
/* Stipple to find illegal accesses */
-
MEMSET(Pike_compiler->fake_object->storage,0x55,256*sizeof(struct svalue));
-
PIKE_MEM_WO_RANGE (Pike_compiler->fake_object->storage,
-
256 * sizeof (struct svalue));
-
}
-
#else
-
Pike_compiler->fake_object->storage=(char *)malloc(sizeof(struct parent_info));
-
#endif
-
if (!Pike_compiler->fake_object->storage) {
-
yyerror("Out of memory when allocating object storage.");
-
}
-
/* Can't use GC_ALLOC on fake objects, but still it's good to know
-
* that they never take over a stale gc marker. */
-
if (Pike_in_gc) remove_marker(Pike_compiler->fake_object);
-
-
Pike_compiler->fake_object->next=Pike_compiler->fake_object;
-
Pike_compiler->fake_object->prev=Pike_compiler->fake_object;
-
Pike_compiler->fake_object->refs=0;
-
add_ref(Pike_compiler->fake_object); /* For DMALLOC... */
-
Pike_compiler->fake_object->prog=p;
-
add_ref(p);
-
-
#ifdef PIKE_DEBUG
-
Pike_compiler->fake_object->program_id=p->id;
-
#endif
-
-
#ifdef PIKE_SECURITY
-
Pike_compiler->fake_object->prot=0;
-
#endif
-
-
debug_malloc_touch(Pike_compiler->fake_object);
-
debug_malloc_touch(Pike_compiler->fake_object->storage);
-
-
if (Pike_compiler->fake_object->storage) {
-
if(name)
-
{
-
/* Fake objects have parents regardless of PROGRAM_USES_PARENT */
-
if((((struct parent_info *)Pike_compiler->fake_object->storage)->parent=Pike_compiler->previous->fake_object))
-
add_ref(Pike_compiler->previous->fake_object);
-
((struct parent_info *)Pike_compiler->fake_object->storage)->parent_identifier=id;
-
}else{
-
((struct parent_info *)Pike_compiler->fake_object->storage)->parent=0;
-
((struct parent_info *)Pike_compiler->fake_object->storage)->parent_identifier=0;
-
}
-
}
-
-
Pike_compiler->new_program=p;
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
if (name) {
-
fprintf (stderr, "%.*sstarting program %d (pass=%d): ",
-
c->compilation_depth, "",
-
Pike_compiler->new_program->id, Pike_compiler->compiler_pass);
-
push_string (name);
-
print_svalue (stderr, --Pike_sp);
-
putc ('\n', stderr);
-
}
-
else
-
fprintf (stderr, "%.*sstarting program %d (pass=%d)\n",
-
c->compilation_depth, "",
-
Pike_compiler->new_program->id, Pike_compiler->compiler_pass);
-
#endif
-
-
if (c->compilation_depth >= 1) {
-
if(TEST_COMPAT(7,2) || (c->lex.pragmas & ID_SAVE_PARENT))
-
{
-
p->flags |= PROGRAM_USES_PARENT;
-
}else if (!(c->lex.pragmas & ID_DONT_SAVE_PARENT)) {
-
struct pike_string *tmp=findstring("__pragma_save_parent__");
-
if(tmp)
-
{
-
struct node_s *n=find_module_identifier(tmp, 0);
-
if(n)
-
{
-
int do_save_parent = !node_is_false(n); /* Default to true. */
-
free_node(n);
-
if (do_save_parent) p->flags |= PROGRAM_USES_PARENT;
-
}
-
}
-
}
-
}
-
-
debug_malloc_touch(Pike_compiler->fake_object);
-
debug_malloc_touch(Pike_compiler->fake_object->storage);
-
-
if(Pike_compiler->new_program->program)
-
{
-
#define FOO(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
Pike_compiler->malloc_size_program->PIKE_CONCAT(num_,NAME) = \
-
Pike_compiler->new_program->PIKE_CONCAT(num_,NAME);
-
#include "program_areas.h"
-
-
{
-
INT_TYPE line = 0;
-
INT32 off = 0;
-
size_t len = 0;
-
INT32 shift = 0;
-
char *file=0;
-
char *cnt=Pike_compiler->new_program->linenumbers;
-
-
while(cnt < Pike_compiler->new_program->linenumbers +
-
Pike_compiler->new_program->num_linenumbers)
-
{
-
if(*cnt == 127)
-
{
-
cnt++;
-
len = get_small_number(&cnt);
-
shift = *cnt;
-
file = ++cnt;
-
CHECK_FILE_ENTRY (Pike_compiler->new_program, cnt, len, shift);
-
cnt += len<<shift;
-
}
-
off+=get_small_number(&cnt);
-
line+=get_small_number(&cnt);
-
}
-
Pike_compiler->last_line=line;
-
Pike_compiler->last_pc=off;
-
if(file)
-
{
-
struct pike_string *str = begin_wide_shared_string(len, shift);
-
if(Pike_compiler->last_file) free_string(Pike_compiler->last_file);
-
memcpy(str->str, file, len<<shift);
-
Pike_compiler->last_file = end_shared_string(str);
-
}
-
}
-
-
}else{
-
static struct pike_string *s;
-
struct inherit i;
-
-
#define START_SIZE 64
-
#ifdef PIKE_USE_MACHINE_CODE
-
#define BAR(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
if (Pike_compiler->new_program->NAME) { \
-
mexec_free(Pike_compiler->new_program->NAME); \
-
Pike_compiler->new_program->PIKE_CONCAT(num_,NAME) = 0; \
-
} \
-
Pike_compiler->malloc_size_program->PIKE_CONCAT(num_,NAME) = \
-
START_SIZE; \
-
Pike_compiler->new_program->NAME = \
-
(TYPE *)mexec_alloc(sizeof(TYPE) * START_SIZE);
-
#endif /* PIKE_USE_MACHINE_CODE */
-
#define FOO(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
if (Pike_compiler->new_program->NAME) { \
-
free (Pike_compiler->new_program->NAME); \
-
Pike_compiler->new_program->PIKE_CONCAT(num_,NAME) = 0; \
-
} \
-
Pike_compiler->malloc_size_program->PIKE_CONCAT(num_,NAME) = \
-
START_SIZE; \
-
Pike_compiler->new_program->NAME = \
-
(TYPE *)xalloc(sizeof(TYPE) * START_SIZE);
-
#include "program_areas.h"
-
-
i.prog=Pike_compiler->new_program;
-
i.identifier_level=0;
-
i.storage_offset=0;
-
i.inherit_level=0;
-
i.identifier_ref_offset=0;
-
i.parent=0;
-
i.parent_identifier=-1;
-
i.parent_offset=OBJECT_PARENT;
-
i.name=0;
-
add_to_inherits(i);
-
}
-
-
Pike_compiler->init_node=0;
-
Pike_compiler->num_parse_error=0;
-
-
push_compiler_frame(0);
-
copy_pike_type(Pike_compiler->compiler_frame->current_return_type,
-
void_type_string);
-
-
debug_malloc_touch(Pike_compiler->fake_object);
-
debug_malloc_touch(Pike_compiler->fake_object->storage);
-
}
-
-
PMOD_EXPORT void debug_start_new_program(INT_TYPE line, const char *file)
-
{
-
struct pike_string *save_file;
-
INT_TYPE save_line;
-
struct compilation *c;
-
-
CHECK_COMPILER();
-
c = THIS_COMPILATION;
-
-
save_file = dmalloc_touch(struct pike_string *, c->lex.current_file);
-
save_line = c->lex.current_line;
-
-
{ /* Trim off the leading path of the compilation environment. */
-
const char *p = DEFINETOSTR(PIKE_SRC_ROOT), *f = file;
-
while (*p && *p == *f) p++, f++;
-
while (*f == '/' || *f == '\\') f++;
-
-
c->lex.current_file = make_shared_string(f);
-
c->lex.current_line = line;
-
}
-
-
CDFPRINTF((stderr,
-
"th(%ld) start_new_program(%ld, %s): "
-
"threads_disabled:%d, compilation_depth:%d\n",
-
(long)th_self(), (long)line, file,
-
threads_disabled, c->compilation_depth));
-
-
low_start_new_program(0,1,0,0,0);
-
store_linenumber(line,c->lex.current_file);
-
debug_malloc_name(Pike_compiler->new_program, file, line);
-
-
free_string(c->lex.current_file);
-
c->lex.current_file = dmalloc_touch(struct pike_string *, save_file);
-
c->lex.current_line = save_line;
-
}
-
-
-
static void exit_program_struct(struct program *p)
-
{
-
unsigned e;
-
-
#ifdef PIKE_DEBUG
-
if (p->refs) {
-
#ifdef DEBUG_MALLOC
-
fprintf (stderr, "Program to be freed still got %d references:\n", p->refs);
-
describe_something(p, T_PROGRAM, 0,2,0, NULL);
-
#endif
-
Pike_fatal("Program to be freed still got %d references.\n", p->refs);
-
}
-
#endif
-
-
if(p->parent)
-
{
-
/* Make sure to break the circularity... */
-
struct program *parent = p->parent;
-
p->parent = NULL;
-
#ifdef PIKE_DEBUG
-
if (!parent->refs) {
-
dump_program_tables(p, 2);
-
fprintf(stderr, "Dead parent:\n");
-
dump_program_tables(parent, 2);
-
Pike_fatal("Program parent is dead.\n");
-
}
-
#endif
-
free_program(parent);
-
}
-
-
/* fprintf(stderr, "Exiting program: %p, id:%d\n", p, p->id); */
-
-
if(id_to_program_cache[p->id & (ID_TO_PROGRAM_CACHE_SIZE-1)]==p)
-
id_to_program_cache[p->id & (ID_TO_PROGRAM_CACHE_SIZE-1)]=0;
-
-
if(p->strings)
-
for(e=0; e<p->num_strings; e++)
-
if(p->strings[e])
-
free_string(p->strings[e]);
-
-
if(p->identifiers)
-
{
-
for(e=0; e<p->num_identifiers; e++)
-
{
-
if(p->identifiers[e].name)
-
free_string(p->identifiers[e].name);
-
if(p->identifiers[e].type)
-
free_type(p->identifiers[e].type);
-
}
-
}
-
-
if(p->constants)
-
{
-
for(e=0;e<p->num_constants;e++)
-
{
-
free_svalue(& p->constants[e].sval);
-
#if 0
-
if(p->constants[e].name) free_string(p->constants[e].name);
-
#endif /* 0 */
-
}
-
}
-
-
if(p->inherits)
-
for(e=0; e<p->num_inherits; e++)
-
{
-
if(p->inherits[e].name)
-
free_string(p->inherits[e].name);
-
if(e)
-
{
-
if(p->inherits[e].prog)
-
free_program(p->inherits[e].prog);
-
}
-
if(p->inherits[e].parent)
-
free_object(p->inherits[e].parent);
-
}
-
-
DOUBLEUNLINK(first_program, p);
-
-
#ifdef WITH_FACETS
-
if(p->facet_group)
-
{
-
free_object(p->facet_group);
-
}
-
#endif
-
-
if(p->flags & PROGRAM_OPTIMIZED)
-
{
-
#ifdef PIKE_USE_MACHINE_CODE
-
do {
-
/* NOTE: Assumes all BAR's are before any FOO. */
-
#define BAR(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
if (p->NAME) mexec_free(p->NAME);
-
#define FOO(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
if (p->NAME) { \
-
dmfree(p->NAME); \
-
break; \
-
}
-
#include "program_areas.h"
-
} while(0);
-
#else /* PIKE_USE_MACHINE_CODE */
-
if(p->program) {
-
dmfree(p->program);
-
}
-
#endif /* PIKE_USE_MACHINE_CODE */
-
#define FOO(NUMTYPE,TYPE,ARGTYPE,NAME) do { \
-
p->NAME=0; \
-
} while(0);
-
-
#include "program_areas.h"
-
}else{
-
#ifdef PIKE_USE_MACHINE_CODE
-
#define BAR(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
if(p->NAME) { \
-
mexec_free((char *)p->NAME); p->NAME=0; \
-
}
-
#endif /* PIKE_USE_MACHINE_CODE */
-
#define FOO(NUMTYPE,TYPE,ARGTYPE,NAME) \
-
if(p->NAME) { \
-
dmfree((char *)p->NAME); p->NAME=0; \
-
}
-
#include "program_areas.h"
-
}
-
-
EXIT_PIKE_MEMOBJ(p);
-
-
GC_FREE(p);
-
}
-
-
#ifdef PIKE_DEBUG
-
void dump_program_desc(struct program *p)
-
{
-
int e,d,q;
-
/* fprintf(stderr,"Program '%s':\n",p->name->str); */
-
-
fprintf(stderr,"$$$$$ dump_program_desc for %p\n", p);
-
-
fprintf(stderr,"All inherits:\n");
-
for(e=0;e<p->num_inherits;e++)
-
{
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"%3d:\n",e);
-
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"inherited program: %d\n",p->inherits[e].prog->id);
-
-
if(p->inherits[e].name)
-
{
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"name : %s\n",p->inherits[e].name->str);
-
}
-
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"inherit_level: %d\n",p->inherits[e].inherit_level);
-
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"identifier_level: %d\n",p->inherits[e].identifier_level);
-
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"parent_identifier: %d\n",p->inherits[e].parent_identifier);
-
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"parent_offset: %d\n",p->inherits[e].parent_offset);
-
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"storage_offset: %ld\n",
-
DO_NOT_WARN((long)p->inherits[e].storage_offset));
-
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"parent: %p\n",p->inherits[e].parent);
-
-
if(p->inherits[e].parent &&
-
p->inherits[e].parent->prog &&
-
p->inherits[e].parent->prog->num_linenumbers>1)
-
{
-
for(d=0;d<p->inherits[e].inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"parent: %s\n",p->inherits[e].parent->prog->linenumbers+1);
-
}
-
}
-
-
fprintf(stderr,"All identifier references:\n");
-
for(e=0;e<(int)p->num_identifier_references;e++)
-
{
-
struct inherit *inh = INHERIT_FROM_INT(p,e);
-
fprintf(stderr,"%3d: ",e);
-
for(d=0;d<inh->inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"%-40s flags 0x%x",ID_FROM_INT(p,e)->name->str,
-
p->identifier_references[e].id_flags);
-
for (q = 0; q < p->num_inherits; q++)
-
if (p->inherits + q == inh) {
-
fprintf(stderr,
-
" inherit %d\n"
-
" type: ",
-
q);
-
simple_describe_type(ID_FROM_INT(p, e)->type);
-
fprintf(stderr, "\n");
-
goto inherit_found;
-
}
-
fprintf (stderr, " inherit not found!\n");
-
inherit_found:;
-
}
-
fprintf(stderr,"All sorted identifiers:\n");
-
for(q=0;q<(int)p->num_identifier_index;q++)
-
{
-
e=p->identifier_index[q];
-
fprintf(stderr,"%3d (%3d):",e,q);
-
for(d=0;d<INHERIT_FROM_INT(p,e)->inherit_level;d++) fprintf(stderr," ");
-
fprintf(stderr,"%s;\n", ID_FROM_INT(p,e)->name->str);
-
}
-
-
fprintf(stderr,"$$$$$ dump_program_desc for %p done\n", p);
-
}
-
#endif
-
-
static void toss_compilation_resources(void)
-
{
-
if(Pike_compiler->fake_object)
-
{
-
if( ((struct parent_info *)Pike_compiler->fake_object->storage)->parent )
-
{
-
free_object(((struct parent_info *)Pike_compiler->fake_object->storage)->parent);
-
-
((struct parent_info *)Pike_compiler->fake_object->storage)->parent=0;
-
}
-
-
free_program(Pike_compiler->fake_object->prog);
-
Pike_compiler->fake_object->prog=0;
-
free_object(Pike_compiler->fake_object);
-
Pike_compiler->fake_object=0;
-
}
-
-
free_program(Pike_compiler->new_program);
-
Pike_compiler->new_program=0;
-
-
if(Pike_compiler->malloc_size_program)
-
{
-
dmfree((char *)Pike_compiler->malloc_size_program);
-
Pike_compiler->malloc_size_program=0;
-
}
-
-
if(Pike_compiler->module_index_cache)
-
{
-
free_mapping(Pike_compiler->module_index_cache);
-
Pike_compiler->module_index_cache=0;
-
}
-
-
while(Pike_compiler->compiler_frame)
-
pop_compiler_frame();
-
-
if(Pike_compiler->last_identifier)
-
{
-
free_string(Pike_compiler->last_identifier);
-
Pike_compiler->last_identifier=0;
-
}
-
-
if(Pike_compiler->last_file)
-
{
-
free_string(Pike_compiler->last_file);
-
Pike_compiler->last_file=0;
-
}
-
-
unuse_modules(Pike_compiler->num_used_modules);
-
}
-
-
int sizeof_variable(int run_time_type)
-
{
-
switch(run_time_type)
-
{
-
case T_FUNCTION:
-
case T_MIXED: return sizeof(struct svalue);
-
case T_FLOAT: return sizeof(FLOAT_TYPE);
-
case T_INT: return sizeof(INT_TYPE);
-
case PIKE_T_FREE:
-
case PIKE_T_GET_SET: return 0;
-
default: return sizeof(void *);
-
}
-
}
-
-
static ptrdiff_t alignof_variable(int run_time_type)
-
{
-
switch(run_time_type)
-
{
-
case T_FUNCTION:
-
case T_MIXED: return ALIGNOF(struct svalue);
-
case T_FLOAT: return ALIGNOF(FLOAT_TYPE);
-
case T_INT: return ALIGNOF(INT_TYPE);
-
case PIKE_T_FREE:
-
case PIKE_T_GET_SET: return 1;
-
default: return ALIGNOF(void *);
-
}
-
}
-
-
#ifdef PIKE_DEBUG
-
-
PMOD_EXPORT void dump_program_tables (const struct program *p, int indent)
-
{
-
int d;
-
-
if (!p) {
-
fprintf(stderr, "%*sProgram: NULL\n\n", indent, "");
-
return;
-
}
-
-
fprintf(stderr,
-
"%*sProgram flags: 0x%04x\n\n",
-
indent, "", p->flags);
-
-
fprintf(stderr,
-
"%*sReference table:\n"
-
"%*s ####: Flags Inherit Identifier\n",
-
indent, "", indent, "");
-
for (d=0; d < p->num_identifier_references; d++) {
-
struct reference *ref = p->identifier_references + d;
-
struct identifier *id = ID_FROM_PTR(p, ref);
-
-
fprintf(stderr,
-
"%*s %4d: %5x %7d %10d %s\n"
-
"%*s %s:%ld\n",
-
indent, "",
-
d, ref->id_flags, ref->inherit_offset,
-
ref->identifier_offset,
-
id->name->size_shift ? "(wide)" : id->name->str,
-
indent, "",
-
p->num_strings?p->strings[id->filename_strno]->str:"-",
-
(long)id->linenumber);
-
if (IDENTIFIER_IS_ALIAS(id->identifier_flags)) {
-
fprintf (stderr, "%*s Alias for %d:%d\n",
-
indent, "", id->func.ext_ref.depth, id->func.ext_ref.id);
-
} else if (IDENTIFIER_IS_CONSTANT(id->identifier_flags)) {
-
fprintf (stderr, "%*s Constant #%ld\n",
-
indent, "", (long)id->func.const_info.offset);
-
} else if (IDENTIFIER_IS_VARIABLE(id->identifier_flags)) {
-
fprintf (stderr, "%*s Offset: 0x%08lx\n",
-
indent, "", (long)id->func.offset);
-
} else if (IDENTIFIER_IS_PIKE_FUNCTION(id->identifier_flags)) {
-
INT_TYPE line;
-
struct program *inh_p = INHERIT_FROM_PTR(p,ref)->prog;
-
struct pike_string *file =
-
get_line (ID_FROM_PTR(p,ref)->func.offset + inh_p->program, inh_p, &line);
-
if (!file->size_shift)
-
fprintf (stderr, "%*s %s:%ld\n",
-
indent, "", file->str, (long)line);
-
free_string (file);
-
} else {
-
fprintf (stderr, "%*s Cfun: %p\n",
-
indent, "", id->func.c_fun);
-
}
-
}
-
-
fprintf(stderr, "\n"
-
"%*sIdentifier index table:\n"
-
"%*s ####: Index\tName\n",
-
indent, "", indent, "");
-
for (d = 0; d < p->num_identifier_index; d++) {
-
struct identifier *id = ID_FROM_INT(p, p->identifier_index[d]);
-
fprintf(stderr, "%*s %4d: %5d\t%s\n",
-
indent, "",
-
d, p->identifier_index[d],
-
id->name->size_shift ? "(wide)" : id->name->str);
-
}
-
-
fprintf(stderr, "\n"
-
"%*sInherit table:\n"
-
"%*s ####: Level prog_id id_level storage_offs "
-
"par_id par_offs par_obj_id id_ref_offs\n",
-
indent, "", indent, "");
-
for (d=0; d < p->num_inherits; d++) {
-
struct inherit *inh = p->inherits + d;
-
-
fprintf(stderr, "%*s %4d: %5d %7d %8d %12"PRINTPTRDIFFT"d %6d %8d %10d %11"PRINTSIZET"d\n",
-
indent, "",
-
d, inh->inherit_level,
-
inh->prog ? inh->prog->id : -1,
-
inh->identifier_level, inh->storage_offset,
-
inh->parent_identifier, inh->parent_offset,
-
inh->parent ? inh->parent->program_id : -1,
-
inh->identifier_ref_offset);
-
}
-
fprintf(stderr, "\n"
-
"%*sIdentifier table:\n"
-
"%*s ####: Flags Offset Type Name\n",
-
indent, "", indent, "");
-
for (d=0; d < p->num_identifiers; d++) {
-
struct identifier *id = p->identifiers + d;
-
-
fprintf(stderr,
-
"%*s %4d: %5x %6"PRINTPTRDIFFT"d %4d \"%s\"\n"
-
"%*s %s:%ld\n",
-
indent, "",
-
d, id->identifier_flags, id->func.offset,
-
id->run_time_type, id->name->str,
-
indent, "",
-
p->num_strings?p->strings[id->filename_strno]->str:"-",
-
(long)id->linenumber);
-
}
-
-
fprintf(stderr, "\n"
-
"%*sVariable table:\n"
-
"%*s ####: Index\n",
-
indent, "", indent, "");
-
for (d = 0; d < p->num_variable_index; d++) {
-
fprintf(stderr, "%*s %4d: %5d\n",
-
indent, "",
-
d, p->variable_index[d]);
-
}
-
fprintf(stderr, "\n"
-
"%*sConstant table:\n"
-
"%*s ####: Type Raw\n",
-
indent, "", indent, "");
-
for (d = 0; d < p->num_constants; d++) {
-
struct program_constant *c = p->constants + d;
-
#if 1
-
fprintf(stderr, "%*s %4d: %-15s %p\n",
-
indent, "",
-
d, get_name_of_type (TYPEOF(c->sval)),
-
c->sval.u.ptr);
-
#else /* !0 */
-
fprintf(stderr, "%*s %4d: %-15s %"PRINTPTRDIFFT"d\n",
-
indent, "",
-
d, get_name_of_type (TYPEOF(c->sval)),
-
c->offset);
-
#endif /* 0 */
-
}
-
-
fprintf(stderr, "\n"
-
"%*sString table:\n"
-
"%*s ####: Value\n",
-
indent, "", indent, "");
-
for (d = 0; d < p->num_strings; d++) {
-
fprintf(stderr, "%*s %4d: [%p]\"%s\"(%"PRINTPTRDIFFT"d characters)\n",
-
indent, "", (int)d, p->strings[d], p->strings[d]->str, p->strings[d]->len);
-
}
-
-
fprintf(stderr, "\n"
-
"%*sLFUN table:\n"
-
"%*s LFUN Ref# Name\n",
-
indent, "", indent, "");
-
for (d = 0; d < NUM_LFUNS; d++) {
-
if (p->lfuns[d] != -1) {
-
fprintf(stderr, "%*s %4d: %04d %s\n",
-
indent, "", d, p->lfuns[d], lfun_names[d]);
-
}
-
}
-
-
fprintf(stderr, "\n"
-
"%*sLinenumber table:\n",
-
indent, "");
-
{
-
INT32 off = 0;
-
INT_TYPE line = 0;
-
char *cnt = p->linenumbers;
-
-
while (cnt < p->linenumbers + p->num_linenumbers) {
-
if (*cnt == 127) {
-
int len, shift;
-
char *file;
-
cnt++;
-
len = get_small_number(&cnt);
-
shift = *cnt;
-
file = ++cnt;
-
CHECK_FILE_ENTRY (p, cnt, len, shift);
-
cnt += len << shift;
-
if (!shift) {
-
fprintf(stderr, "%*s Filename: \"%s\"\n", indent, "", file);
-
} else {
-
fprintf(stderr, "%*s Filename: len:%d, shift:%d\n", indent, "", len, shift);
-
}
-
}
-
off += get_small_number(&cnt);
-
line += get_small_number(&cnt);
-
fprintf(stderr, "%*s %8d:%8ld\n", indent, "", off, (long)line);
-
}
-
}
-
-
fprintf(stderr, "\n");
-
}
-
-
void check_program(struct program *p)
-
{
-
unsigned INT32 e;
-
int variable_positions[1024];
-
-
if(p->flags & PROGRAM_AVOID_CHECK) return;
-
-
for(e=0;e<NELEM(variable_positions);e++)
-
variable_positions[e]=-1;
-
-
if(p->id > current_program_id)
-
Pike_fatal("Program id is out of sync! (p->id=%d, current_program_id=%d)\n",p->id,current_program_id);
-
-
if(p->refs <=0)
-
Pike_fatal("Program has zero refs.\n");
-
-
if(p->next && p->next->prev != p)
-
Pike_fatal("Program ->next->prev != program.\n");
-
-
if(p->prev)
-
{
-
if(p->prev->next != p)
-
Pike_fatal("Program ->prev->next != program.\n");
-
}else{
-
if(first_program != p)
-
Pike_fatal("Program ->prev == 0 but first_program != program.\n");
-
}
-
-
if(p->id > current_program_id || p->id <= 0)
-
Pike_fatal("Program id is wrong.\n");
-
-
if(p->storage_needed < 0)
-
Pike_fatal("Program->storage_needed < 0.\n");
-
-
if(p->num_identifier_index > p->num_identifier_references)
-
Pike_fatal("Too many identifier index entries in program!\n");
-
-
for(e=0;e<p->num_constants;e++)
-
{
-
struct svalue *s = & p->constants[e].sval;
-
check_svalue(s);
-
if (p->flags & PROGRAM_FINISHED && TYPEOF(*s) == T_OBJECT &&
-
s->u.object->next == s->u.object)
-
Pike_fatal ("Got fake object in constant in finished program.\n");
-
#if 0
-
if(p->constants[e].name) check_string(p->constants[e].name);
-
#else /* ! 0 */
-
if (p->constants[e].offset >= p->num_identifiers) {
-
Pike_fatal("Constant initializer outside num_identifiers (%d >= %d).\n",
-
p->constants[e].offset, p->num_identifiers);
-
}
-
#endif /* 0 */
-
}
-
-
for(e=0;e<p->num_strings;e++)
-
check_string(p->strings[e]);
-
-
for(e=0;e<p->num_inherits;e++)
-
{
-
if(!p->inherits[e].prog)
-
{
-
/* This inherit is not yet initialized, ignore rest of tests.. */
-
return;
-
}
-
-
if(p->inherits[e].storage_offset < 0)
-
Pike_fatal("Inherit->storage_offset is wrong.\n");
-
-
if(p->inherits[e].prog &&
-
p->inherits[e].storage_offset + STORAGE_NEEDED(p->inherits[e].prog) >
-
p->storage_needed)
-
Pike_fatal("Not enough room allocated by inherit!\n");
-
-
if (p->inherits[e].inherit_level == 1 &&
-
p->inherits[e].identifier_level != (INT32) p->inherits[e].identifier_ref_offset) {
-
dump_program_tables (p, 0);
-
Pike_fatal ("Unexpected difference between identifier_level "
-
"and identifier_ref_offset in inherit %d.\n", e);
-
}
-
-
if(e)
-
{
-
if(p->inherits[e-1].storage_offset >
-
p->inherits[e].storage_offset)
-
Pike_fatal("Overlapping inherits! (1)\n");
-
-
if(p->inherits[e-1].prog &&
-
p->inherits[e-1].inherit_level >= p->inherits[e].inherit_level &&
-
( p->inherits[e-1].storage_offset +
-
STORAGE_NEEDED(p->inherits[e-1].prog)) >
-
p->inherits[e].storage_offset)
-
Pike_fatal("Overlapping inherits! (3)\n");
-
}
-
}
-
-
-
if(p->flags & PROGRAM_FINISHED)
-
for(e=0;e<p->num_identifiers;e++)
-
{
-
check_string(p->identifiers[e].name);
-
check_type_string(p->identifiers[e].type);
-
-
switch (p->identifiers[e].identifier_flags & IDENTIFIER_TYPE_MASK) {
-
case IDENTIFIER_VARIABLE:
-
case IDENTIFIER_PIKE_FUNCTION:
-
case IDENTIFIER_C_FUNCTION:
-
case IDENTIFIER_CONSTANT:
-
break;
-
-
default:
-
Pike_fatal("Invalid identifier type.\n");
-
}
-
-
if(p->identifiers[e].identifier_flags & ~IDENTIFIER_MASK)
-
Pike_fatal("Unknown flags in identifier flag field.\n");
-
-
if((p->identifiers[e].run_time_type!=T_MIXED) &&
-
(p->identifiers[e].run_time_type!=PIKE_T_FREE) &&
-
(p->identifiers[e].run_time_type!=PIKE_T_GET_SET))
-
check_type(p->identifiers[e].run_time_type);
-
-
if (!IDENTIFIER_IS_ALIAS(p->identifiers[e].identifier_flags)) {
-
if(IDENTIFIER_IS_VARIABLE(p->identifiers[e].identifier_flags))
-
{
-
if((p->identifiers[e].func.offset /* + OFFSETOF(object,storage)*/ ) &
-
(alignof_variable(p->identifiers[e].run_time_type)-1))
-
{
-
dump_program_tables(p, 0);
-
Pike_fatal("Variable %s offset is not properly aligned (%ld).\n",
-
p->identifiers[e].name->str,
-
PTRDIFF_T_TO_LONG(p->identifiers[e].func.offset));
-
}
-
}
-
} else {
-
/* FIXME: Check that ext_ref.depth and ext_ref.id are valid and
-
* have matching identifier_flags.
-
*/
-
if (p->identifiers[e].func.ext_ref.depth &&
-
!(p->flags & PROGRAM_USES_PARENT)) {
-
Pike_fatal("Identifier %d is an external reference, but "
-
"PROGRAM_USES_PARENT hasn't been set.\n",
-
e);
-
}
-
}
-
}
-
-
for(e=0;e<p->num_identifier_references;e++)
-
{
-
struct identifier *i;
-
if(p->identifier_references[e].inherit_offset > p->num_inherits)
-
Pike_fatal("Inherit offset is wrong!\n");
-
-
if(!p->inherits[p->identifier_references[e].inherit_offset].prog)
-
{
-
if(!(p->flags & PROGRAM_FINISHED))
-
continue;
-
-
Pike_fatal("p->inherit[%d].prog = NULL!\n",p->identifier_references[e].inherit_offset);
-
}
-
-
if(p->identifier_references[e].identifier_offset >
-
p->inherits[p->identifier_references[e].inherit_offset].prog->num_identifiers)
-
Pike_fatal("Identifier offset %d is wrong! %d > %d\n",
-
e,
-
p->identifier_references[e].identifier_offset,
-
p->inherits[p->identifier_references[e].inherit_offset].prog->num_identifiers);
-
-
i=ID_FROM_INT(p, e);
-
-
if (IDENTIFIER_IS_ALIAS(i->identifier_flags)) {
-
if ((!i->func.ext_ref.depth) && (i->func.ext_ref.id == e)) {
-
dump_program_tables(p, 0);
-
Pike_fatal("Circular alias for reference %d!\n", e);
-
}
-
} else if (IDENTIFIER_IS_VARIABLE(i->identifier_flags)) {
-
size_t q, size;
-
/* Variable */
-
ptrdiff_t offset = INHERIT_FROM_INT(p, e)->storage_offset+i->func.offset;
-
if (i->run_time_type == PIKE_T_GET_SET) {
-
struct reference *ref = PTR_FROM_INT(p, e);
-
if (!ref->inherit_offset) {
-
if (i->func.gs_info.getter >= p->num_identifier_references) {
-
Pike_fatal("Getter outside references.\n");
-
}
-
if (i->func.gs_info.setter >= p->num_identifier_references) {
-
Pike_fatal("Setter outside references.\n");
-
}
-
}
-
continue;
-
}
-
size=sizeof_variable(i->run_time_type);
-
-
if(size && ((offset+size > (size_t)p->storage_needed) || offset<0))
-
Pike_fatal("Variable outside storage! (%s)\n",i->name->str);
-
-
for(q=0;q<size;q++)
-
{
-
if(offset+q >= NELEM(variable_positions)) break;
-
-
if(variable_positions[offset+q] != -1)
-
{
-
if(ID_FROM_INT(p,variable_positions[offset+q])->run_time_type !=
-
i->run_time_type)
-
{
-
fprintf(stderr, "Storage offset: "
-
"0x%08"PRINTPTRDIFFT"x vs 0x%08"PRINTPTRDIFFT"x\n"
-
"Func offset: 0x%08"PRINTPTRDIFFT"x vs 0x%08"PRINTPTRDIFFT"x\n"
-
"Type: %s vs %s\n",
-
INHERIT_FROM_INT(p, variable_positions[offset+q])->
-
storage_offset,
-
INHERIT_FROM_INT(p, e)->storage_offset,
-
ID_FROM_INT(p, variable_positions[offset+q])->func.offset,
-
i->func.offset,
-
get_name_of_type(ID_FROM_INT(p,variable_positions[offset+q]
-
)->run_time_type),
-
get_name_of_type(i->run_time_type));
-
if (i->name) {
-
Pike_fatal("Variable '%s' and '%s' overlap\n"
-
"Offset 0x%08"PRINTPTRDIFFT"x - 0x%08"PRINTPTRDIFFT"x "
-
"overlaps with "
-
"0x%08"PRINTPTRDIFFT"x - 0x%08"PRINTPTRDIFFT"x\n",
-
ID_FROM_INT(p, variable_positions[offset+q])->name->str,
-
i->name->str,
-
INHERIT_FROM_INT(p, variable_positions[offset+q])->
-
storage_offset +
-
ID_FROM_INT(p, variable_positions[offset+q])->func.offset,
-
INHERIT_FROM_INT(p, variable_positions[offset+q])->
-
storage_offset +
-
ID_FROM_INT(p, variable_positions[offset+q])->func.offset +
-
sizeof_variable(ID_FROM_INT(p, variable_positions[offset+q]
-
)->run_time_type)-1,
-
offset, offset+size-1);
-
} else {
-
Pike_fatal("Variable '%s' and anonymous variable (%d) overlap\n"
-
"Offset 0x%08"PRINTPTRDIFFT"x - 0x%08"PRINTPTRDIFFT"x "
-
"overlaps with "
-
"0x%08"PRINTPTRDIFFT"x - 0x%08"PRINTPTRDIFFT"x\n",
-
ID_FROM_INT(p, variable_positions[offset+q])->name->str,
-
e,
-
INHERIT_FROM_INT(p, variable_positions[offset+q])->
-
storage_offset +
-
ID_FROM_INT(p, variable_positions[offset+q])->func.offset,
-
INHERIT_FROM_INT(p, variable_positions[offset+q])->
-
storage_offset +
-
ID_FROM_INT(p, variable_positions[offset+q])->func.offset +
-
sizeof_variable(ID_FROM_INT(p, variable_positions[offset+q]
-
)->run_time_type)-1,
-
offset, offset+size-1);
-
}
-
}
-
}
-
variable_positions[offset+q]=e;
-
}
-
}
-
}
-
-
for(e=0;e<p->num_identifier_index;e++)
-
{
-
if(p->identifier_index[e] > p->num_identifier_references)
-
Pike_fatal("Program->identifier_indexes[%ld] is wrong\n",(long)e);
-
if (e && (program_identifier_index_compare(p->identifier_index[e-1],
-
p->identifier_index[e],
-
p) > 0)) {
-
Pike_fatal("Program->identifier_index[%ld] > "
-
"Program->identifier_index[%ld]\n",
-
(long)(e-1), (long)e);
-
}
-
}
-
-
}
-
#endif
-
-
static void f_dispatch_variant(INT32 args);
-
-
/* Note: This function is misnamed, since it's run after both passes. /mast */
-
/* finish-states:
-
*
-
* 0: First pass.
-
* 1: Last pass.
-
* 2: Called from decode_value().
-
*/
-
struct program *end_first_pass(int finish)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
int e;
-
struct program *prog = Pike_compiler->new_program;
-
struct pike_string *s;
-
int num_refs = prog->num_identifier_references;
-
union idptr dispatch_fun;
-
-
dispatch_fun.c_fun = f_dispatch_variant;
-
-
/* Collect variant functions that have been defined in this program,
-
* and add the corresponding dispatchers.
-
*/
-
for (e = 0; e < num_refs; e++) {
-
struct identifier *id;
-
struct pike_string *name;
-
struct pike_type *type;
-
int id_flags;
-
int j;
-
if (prog->identifier_references[e].inherit_offset) continue;
-
if (!((id_flags = prog->identifier_references[e].id_flags) & ID_VARIANT)) {
-
/* Not a variant function. */
-
continue;
-
}
-
id = ID_FROM_INT(prog, e);
-
name = id->name;
-
type = id->type;
-
-
CDFPRINTF((stderr, "Collecting variants of \"%s\"...\n", name->str));
-
-
/* Check whether we've added a dispatcher for this function already. */
-
j = isidentifier(name);
-
if ((j >= 0) && (!prog->identifier_references[j].inherit_offset)) {
-
/* Already handled. */
-
CDFPRINTF((stderr, "Dispatcher present!\n"));
-
goto next_ref;
-
}
-
-
#ifdef COMPILER_DEBUG
-
fprintf(stderr, "type: ");
-
simple_describe_type(type);
-
fprintf(stderr, "\n");
-
#endif
-
-
/* Collect the other variants of the function. */
-
for (j = e+1; j < num_refs; j++) {
-
if (prog->identifier_references[j].inherit_offset) continue;
-
if (!(prog->identifier_references[j].id_flags & ID_VARIANT)) continue;
-
id = ID_FROM_INT(prog, j);
-
if (name != id->name) continue;
-
id_flags |= prog->identifier_references[j].id_flags;
-
type = or_pike_types(type, id->type, 1);
-
#ifdef COMPILER_DEBUG
-
fprintf(stderr, "type: ");
-
simple_describe_type(id->type);
-
fprintf(stderr, "\n");
-
#endif
-
}
-
/* Include the directly inherited variants as well. */
-
for (j = 1; j < prog->num_inherits; j++) {
-
struct inherit *inh = &prog->inherits[j];
-
if (inh->inherit_level != 1) continue;
-
e = really_low_find_shared_string_identifier(name, inh->prog,
-
SEE_PROTECTED);
-
if (e == -1) continue;
-
id = ID_FROM_INT(inh->prog, e);
-
id_flags |= inh->prog->identifier_references[e].id_flags;
-
type = or_pike_types(type, id->type, 1);
-
}
-
#ifdef COMPILER_DEBUG
-
fprintf(stderr, "Dispatcher type: ");
-
simple_describe_type(type);
-
fprintf(stderr, "\n");
-
#endif
-
define_function(name, type, id_flags & ~ID_VARIANT,
-
IDENTIFIER_C_FUNCTION, &dispatch_fun, 0);
-
next_ref:
-
;
-
}
-
-
debug_malloc_touch(Pike_compiler->fake_object);
-
debug_malloc_touch(Pike_compiler->fake_object->storage);
-
-
MAKE_CONST_STRING(s,"__INIT");
-
-
-
/* Collect references to inherited __INIT functions */
-
if (!(Pike_compiler->new_program->flags & PROGRAM_AVOID_CHECK)) {
-
for(e=Pike_compiler->new_program->num_inherits-1;e;e--)
-
{
-
int id;
-
if(Pike_compiler->new_program->inherits[e].inherit_level!=1) continue;
-
id=low_reference_inherited_identifier(0, e, s, SEE_PROTECTED);
-
if(id!=-1)
-
{
-
Pike_compiler->init_node=mknode(F_COMMA_EXPR,
-
mkcastnode(void_type_string,
-
mkapplynode(mkidentifiernode(id),0)),
-
Pike_compiler->init_node);
-
}
-
}
-
}
-
-
/*
-
* Define the __INIT function, but only if there was any code
-
* to initialize.
-
*/
-
-
if(Pike_compiler->init_node)
-
{
-
Pike_compiler->compiler_frame->current_function_number = -2;
-
e=dooptcode(s,
-
mknode(F_COMMA_EXPR,
-
Pike_compiler->init_node,
-
mknode(F_RETURN,mkintnode(0),0)),
-
function_type_string,
-
ID_PROTECTED);
-
Pike_compiler->init_node=0;
-
} else if (finish == 2) {
-
/* Called from decode_value(). */
-
e = low_find_lfun(Pike_compiler->new_program, LFUN___INIT);
-
}else{
-
e=-1;
-
}
-
Pike_compiler->new_program->lfuns[LFUN___INIT]=e;
-
-
pop_compiler_frame(); /* Pop __INIT local variables */
-
-
if(Pike_compiler->num_parse_error > 0)
-
{
-
CDFPRINTF((stderr, "th(%ld) %p Compilation errors (%d).\n",
-
(long)th_self(), Pike_compiler->new_program,
-
Pike_compiler->num_parse_error));
-
prog=0;
-
}else{
-
prog=Pike_compiler->new_program;
-
add_ref(prog);
-
-
Pike_compiler->new_program->flags |= PROGRAM_PASS_1_DONE;
-
-
if(finish)
-
{
-
if(Pike_compiler->new_program->flags & PROGRAM_USES_PARENT)
-
{
-
Pike_compiler->new_program->parent_info_storage =
-
add_xstorage(sizeof(struct parent_info),
-
ALIGNOF(struct parent_info),
-
0);
-
}else{
-
/* Cause errors if used hopefully */
-
Pike_compiler->new_program->parent_info_storage=-1;
-
}
-
-
fixate_program();
-
if(Pike_compiler->num_parse_error)
-
{
-
free_program(prog);
-
prog=0;
-
}else{
-
optimize_program(Pike_compiler->new_program);
-
Pike_compiler->new_program->flags |= PROGRAM_FINISHED;
-
}
-
}
-
-
#ifdef PIKE_DEBUG
-
if (prog) {
-
check_program(prog);
-
if(l_flag)
-
dump_program_desc(prog);
-
}
-
#endif
-
}
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
fprintf (stderr, "%.*sfinishing program %d (pass=%d)\n",
-
c->compilation_depth, "",
-
Pike_compiler->new_program->id, Pike_compiler->compiler_pass);
-
#endif
-
-
toss_compilation_resources();
-
-
#if 0
-
CDFPRINTF((stderr,
-
"th(%ld) end_first_pass(): "
-
"%p compilation_depth:%d, Pike_compiler->compiler_pass:%d\n",
-
(long)th_self(), prog,
-
c->compilation_depth, Pike_compiler->compiler_pass));
-
#endif
-
-
if(!Pike_compiler->compiler_frame && (Pike_compiler->compiler_pass==2 || !prog) && c->resolve_cache)
-
{
-
free_mapping(dmalloc_touch(struct mapping *, c->resolve_cache));
-
c->resolve_cache=0;
-
}
-
-
#ifdef SHARED_NODES
-
/* free(node_hash.table); */
-
#endif /* SHARED_NODES */
-
-
#define POP
-
#include "compilation.h"
-
-
exit_type_stack();
-
-
free_all_nodes();
-
-
CDFPRINTF((stderr,
-
"th(%ld) %p end_first_pass(%d): "
-
"threads_disabled:%d, compilation_depth:%d\n",
-
(long)th_self(), prog, finish,
-
threads_disabled, c->compilation_depth));
-
-
c->compilation_depth--;
-
-
exit_threads_disable(NULL);
-
-
#if 0
-
#ifdef PIKE_USE_MACHINE_CODE
-
if (prog &&
-
(((unsigned long long *)prog->program)[-1] != 0xdeadfeedf00dfaddLL)) {
-
Pike_fatal("Bad mexec magic!\n");
-
}
-
#endif /* PIKE_USE_MACHINE_CODE */
-
#endif /* 0 */
-
return prog;
-
}
-
-
/*
-
* Finish this program, returning the newly built program
-
*/
-
PMOD_EXPORT struct program *debug_end_program(void)
-
{
-
Pike_compiler->compiler_pass = 2;
-
return end_first_pass(1);
-
}
-
-
-
/*
-
* Allocate space needed for this program in the object structure.
-
* An offset to the data is returned.
-
*/
-
PMOD_EXPORT size_t low_add_storage(size_t size, size_t alignment,
-
ptrdiff_t modulo_orig)
-
{
-
ptrdiff_t offset;
-
ptrdiff_t modulo;
-
-
if(!size) return Pike_compiler->new_program->storage_needed;
-
-
#ifdef PIKE_DEBUG
-
if(alignment <=0 || (alignment & (alignment-1)) || alignment > 256)
-
Pike_fatal("Alignment must be 1,2,4,8,16,32,64,128 or 256 not %ld\n",
-
PTRDIFF_T_TO_LONG(alignment));
-
#endif
-
modulo=( modulo_orig /* +OFFSETOF(object,storage) */ ) % alignment;
-
-
offset=DO_ALIGN(Pike_compiler->new_program->storage_needed-modulo,alignment)+modulo;
-
-
if(!Pike_compiler->new_program->storage_needed) {
-
/* Shouldn't Pike_compiler->new_program->storage_needed be set here?
-
* Otherwise the debug code below ought to be trigged.
-
* But since it isn't, I guess this is dead code?
-
* /grubba 1999-09-28
-
*
-
* No, the below offset represents the storage in the beginning
-
* of obj->storage which is not used because of alignment constraints.
-
* However, for historical reasons, prog->storage_offset needs to
-
* contain this unused space as well. This means that the real
-
* space used by all variables in an object is really:
-
* o->prog->storage_needed - o->prog->inherits[0].storage_offset,
-
* This can also be written as STORAGE_NEEDED(o->prog)
-
* STORAGE_NEEDED() is defined in program.h.
-
* /Hubbe 1999-09-29
-
*
-
* Oops, seems I read the test below the wrong way around.
-
* /grubba 1999-09-29
-
*/
-
Pike_compiler->new_program->inherits[0].storage_offset=offset;
-
}
-
-
if(Pike_compiler->new_program->alignment_needed<alignment)
-
Pike_compiler->new_program->alignment_needed =
-
DO_NOT_WARN((unsigned INT8)alignment);
-
-
#ifdef PIKE_DEBUG
-
if(offset < Pike_compiler->new_program->storage_needed)
-
Pike_fatal("add_storage failed horribly!\n");
-
-
if( (offset /* + OFFSETOF(object,storage) */ - modulo_orig ) % alignment )
-
Pike_fatal("add_storage failed horribly(2) %ld %ld %ld %ld!\n",
-
DO_NOT_WARN((long)offset),
-
(long)0 /* + OFFSETOF(object,storage) */,
-
DO_NOT_WARN((long)modulo_orig),
-
DO_NOT_WARN((long)alignment));
-
-
#endif
-
-
Pike_compiler->new_program->storage_needed = offset + size;
-
-
return (size_t) offset;
-
}
-
-
/*
-
* Internal function.
-
* Adds object storage that will *not* be inherited.
-
*/
-
static size_t add_xstorage(size_t size,
-
size_t alignment,
-
ptrdiff_t modulo_orig)
-
{
-
ptrdiff_t offset, modulo, available;
-
int e;
-
-
if(!size) return Pike_compiler->new_program->xstorage;
-
-
modulo=( modulo_orig /* +OFFSETOF(object,storage) */ ) % alignment;
-
-
offset=DO_ALIGN(Pike_compiler->new_program->xstorage-modulo,alignment)+modulo;
-
-
Pike_compiler->new_program->xstorage = offset + size;
-
-
/* Move all inherits to make room */
-
available = Pike_compiler->new_program->inherits[0].storage_offset;
-
if(available < (ptrdiff_t)(offset+size))
-
{
-
available=
-
DO_ALIGN( ((offset + size) - available),
-
Pike_compiler->new_program->alignment_needed);
-
-
for(e=0;e<Pike_compiler->new_program->num_inherits;e++)
-
Pike_compiler->new_program->inherits[e].storage_offset+=available;
-
-
Pike_compiler->new_program->storage_needed+=available;
-
}
-
-
return (size_t) offset;
-
}
-
-
typedef void (*oldhandlertype)(struct object *);
-
-
static void compat_event_handler(int e)
-
{
-
oldhandlertype handler;
-
debug_malloc_touch(Pike_fp->current_object);
-
handler=((oldhandlertype *)Pike_fp->context->prog->program)[e];
-
if(handler) handler(Pike_fp->current_object);
-
debug_malloc_touch(Pike_fp->current_object);
-
}
-
-
static void add_compat_event_handler(void)
-
{
-
if(Pike_compiler->new_program->event_handler != compat_event_handler)
-
{
-
unsigned int e,d;
-
unsigned char *tmp=(unsigned char *)&Pike_compiler->new_program->event_handler;
-
-
for(d=0;d<NUM_PROG_EVENTS;d++) {
-
/* FIXME: This looks like it might be broken. */
-
/* Broken how? -Hubbe */
-
#ifdef HAVE_COMPUTED_GOTO
-
add_to_program(Pike_compiler->new_program->event_handler);
-
#else /* !HAVE_COMPUTED_GOTO */
-
for(e=0;e<sizeof(Pike_compiler->new_program->event_handler);e++)
-
add_to_program(tmp[e]);
-
#endif /* HAVE_COMPUTED_GOTO */
-
}
-
Pike_compiler->new_program->event_handler=compat_event_handler;
-
}
-
}
-
-
/*
-
* Set a callback to be called when this program is cloned.
-
*
-
* This function is obsolete; see pike_set_prog_event_callback for
-
* details.
-
*/
-
PMOD_EXPORT void set_init_callback(void (*init)(struct object *))
-
{
-
add_compat_event_handler();
-
((oldhandlertype *)Pike_compiler->new_program->program)[PROG_EVENT_INIT]=init;
-
}
-
-
/*
-
* Set a callback to be called when clones of this program are
-
* destructed.
-
*
-
* This function is obsolete; see pike_set_prog_event_callback for
-
* details.
-
*
-
* Note: If the callback only does very trivial stuff, like freeing or
-
* clearing a few pointers in the object storage, you can do
-
*
-
* Pike_compiler->new_program->flags &= ~PROGRAM_LIVE_OBJ;
-
*
-
* after the set_exit_callback call. That allows the gc to operate
-
* more efficiently, but the effect is that the callback might be
-
* called out of order for PROG_EVENT_EXIT events; see the docs for
-
* PROGRAM_LIVE_OBJ in program.h for further details.
-
*/
-
PMOD_EXPORT void set_exit_callback(void (*exit)(struct object *))
-
{
-
add_compat_event_handler();
-
((oldhandlertype *)Pike_compiler->new_program->program)[PROG_EVENT_EXIT]=exit;
-
Pike_compiler->new_program->flags |= PROGRAM_LIVE_OBJ;
-
}
-
-
/*
-
* This callback is used by the gc to traverse all references to
-
* things in memory. It should call some gc_recurse_* function exactly
-
* once for each reference that the pike internals doesn't know about.
-
*
-
* If a reference is shared between objects, it should be traversed
-
* once for every instance sharing it.
-
*
-
* The callback might be called more than once for the same instance
-
* during a gc pass. The gc assumes that the references are enumerated
-
* in the same order in that case.
-
*
-
* The callback is called after any mapped variables on the object
-
* have been recursed (and possibly freed).
-
*
-
* If there are pointers to allocated memory that you keep track of on
-
* the C level then you should add something like this to the recurse
-
* callback so that Pike.count_memory remains accurate:
-
*
-
* if (mc_count_bytes (Pike_fp->current_object))
-
* mc_counted_bytes += <size of the allocated memory block(s)>
-
*
-
* If the allocated memory is shared between objects then it gets more
-
* complicated and you need to write visit_thing_fn callbacks. See
-
* e.g. visit_mapping and visit_mapping_data for how to do that.
-
*
-
* This function is obsolete; see pike_set_prog_event_callback for
-
* details.
-
*/
-
PMOD_EXPORT void set_gc_recurse_callback(void (*m)(struct object *))
-
{
-
add_compat_event_handler();
-
((oldhandlertype *)Pike_compiler->new_program->program)[PROG_EVENT_GC_RECURSE]=m;
-
}
-
-
/*
-
* This callback is used by the gc to count all references to things
-
* in memory. It should call gc_check, gc_check_(weak_)svalues or
-
* gc_check_(weak_)short_svalue exactly once for each reference that
-
* the pike internals don't know about.
-
*
-
* If a reference is shared between objects, it should be counted once
-
* for all shared instances. The return value from gc_check is useful
-
* to ensure this; it's zero when called the first time for its
-
* argument (it is perfectly fine to use gc_check on things that the
-
* pike core doesn't know about, but they must have an INT32 refcount
-
* first).
-
*
-
* This function is obsolete; see pike_set_prog_event_callback for
-
* details.
-
*/
-
PMOD_EXPORT void set_gc_check_callback(void (*m)(struct object *))
-
{
-
add_compat_event_handler();
-
((oldhandlertype *)Pike_compiler->new_program->program)[PROG_EVENT_GC_CHECK]=m;
-
}
-
-
/*
-
* Set a callback to be called when any of the special program events
-
* occur. The event type is sent as an integer argument. The events
-
* include, but might not be limited to, the following:
-
*
-
* PROG_EVENT_INIT
-
* An object is being cloned from the program. See set_init_callback
-
* for details.
-
* PROG_EVENT_EXIT
-
* An object is being destructed. See set_exit_callback for details.
-
* PROG_EVENT_GC_RECURSE
-
* An object is being recursed by the gc. See
-
* set_gc_recurse_callback for details.
-
* PROG_EVENT_GC_CHECK
-
* An object is being checked by the gc. See set_gc_check_callback
-
* for details.
-
*
-
* Note that installing an event callback will set the
-
* PROGRAM_LIVE_OBJ flag since the callback might act on the
-
* PROG_EVENT_EXIT event. If the callback won't do anything for that
-
* event (or if it only does something very trivial for it), you
-
* should do
-
*
-
* Pike_compiler->new_program->flags &= ~PROGRAM_LIVE_OBJ;
-
*
-
* afterwards to clear it again. That allows the gc to operate more
-
* efficiently, but the effect is that the callback might be called
-
* out of order for PROG_EVENT_EXIT events; see the docs for
-
* PROGRAM_LIVE_OBJ in program.h for further details.
-
*/
-
PMOD_EXPORT void pike_set_prog_event_callback(void (*cb)(int))
-
{
-
#ifdef PIKE_DEBUG
-
if(Pike_compiler->new_program->event_handler)
-
Pike_fatal("Program already has an event handler!\n");
-
#endif
-
Pike_compiler->new_program->event_handler=cb;
-
Pike_compiler->new_program->flags |= PROGRAM_LIVE_OBJ;
-
}
-
-
PMOD_EXPORT void pike_set_prog_optimize_callback(node *(*opt)(node *))
-
{
-
#ifdef PIKE_DEBUG
-
if(Pike_compiler->new_program->optimize)
-
Pike_fatal("Program already has an optimize handler!\n");
-
#endif
-
Pike_compiler->new_program->optimize = opt;
-
}
-
-
int really_low_reference_inherited_identifier(struct program_state *q,
-
int e,
-
int i)
-
{
-
struct program *np=(q?q:Pike_compiler)->new_program;
-
struct reference funp;
-
struct program *p;
-
int d, num_id_refs;
-
-
if(i==-1) return -1;
-
-
p = np->inherits[e].prog;
-
-
funp = p->identifier_references[i];
-
funp.inherit_offset += e;
-
funp.id_flags = (funp.id_flags & ~ID_INHERITED) | ID_INLINE|ID_HIDDEN;
-
-
num_id_refs = np->num_identifier_references;
-
-
for(d = 0; d < num_id_refs; d++)
-
{
-
struct reference *refp;
-
refp = np->identifier_references + d;
-
-
if ((refp->inherit_offset == funp.inherit_offset) &&
-
(refp->identifier_offset == funp.identifier_offset) &&
-
((refp->id_flags | ID_USED) == (funp.id_flags | ID_USED)))
-
return d;
-
}
-
-
funp.run_time_type = PIKE_T_UNKNOWN;
-
-
if(q)
-
low_add_to_identifier_references(q,funp);
-
else
-
add_to_identifier_references(funp);
-
/* NOTE: np->num_identifier_references has been increased by one by
-
* {low_,}add_to_identifier_references().
-
*/
-
#ifdef PIKE_DEBUG
-
if (num_id_refs != np->num_identifier_references-1) {
-
fatal("Unexpected number of identifier references: %d != %d\n",
-
num_id_refs, np->num_identifier_references-1);
-
}
-
#endif /* PIKE_DEBUG */
-
return num_id_refs; /* aka np->num_identifier_references - 1 */
-
}
-
-
int low_reference_inherited_identifier(struct program_state *q,
-
int e,
-
struct pike_string *name,
-
int flags)
-
{
-
struct program *np=(q?q:Pike_compiler)->new_program;
-
struct program *p;
-
int i;
-
-
p=np->inherits[e].prog;
-
i=find_shared_string_identifier(name,p);
-
if(i==-1)
-
{
-
i=really_low_find_shared_string_identifier(name,p, flags);
-
if(i==-1) return -1;
-
}
-
-
if(p->identifier_references[i].id_flags & ID_HIDDEN)
-
return -1;
-
-
if(p->identifier_references[i].id_flags & ID_PRIVATE)
-
if(!(flags & SEE_PRIVATE))
-
return -1;
-
-
return really_low_reference_inherited_identifier(q, e, i);
-
}
-
-
int find_inherit(struct program *p, struct pike_string *name)
-
{
-
int e;
-
-
#if 0
-
fprintf(stderr, "find_inherit(0x%08lx, \"%s\")...\n",
-
(unsigned long)p, name->str);
-
#endif /* 0 */
-
/* FIXME: This loop could be optimized by advancing by the number
-
* of inherits in the inherit. But in that case the loop
-
* would have to go the other way.
-
*/
-
for(e = p->num_inherits-1; e>0; e--) {
-
#if 0
-
fprintf(stderr, " %04d: %04d %s\n",
-
e, p->inherits[e].inherit_level,
-
p->inherits[e].name?p->inherits[e].name->str:"NULL");
-
#endif /* 0 */
-
if (p->inherits[e].inherit_level > 1) continue;
-
if (name == p->inherits[e].name) return e;
-
}
-
return 0;
-
}
-
-
/* Reference the symbol inherit::name in the lexical context
-
* specified by state.
-
*
-
* Returns the reference in state->new_program if found.
-
*/
-
PMOD_EXPORT int reference_inherited_identifier(struct program_state *state,
-
struct pike_string *inherit,
-
struct pike_string *name)
-
{
-
int e, id;
-
struct program *p;
-
-
#ifdef PIKE_DEBUG
-
if (name != debug_findstring(name))
-
Pike_fatal("reference_inherited_identifier on nonshared string.\n");
-
#endif
-
-
if (!state) state = Pike_compiler;
-
-
p = state->new_program;
-
-
/* FIXME: This loop could be optimized by advancing by the number
-
* of inherits in the inherit. But in that case the loop
-
* would have to go the other way.
-
*/
-
for (e = p->num_inherits; e--;) {
-
if (p->inherits[e].inherit_level != 1) continue;
-
if (inherit && (inherit != p->inherits[e].name)) continue;
-
-
id = low_reference_inherited_identifier(state, e, name, SEE_PROTECTED);
-
-
if (id != -1) return id;
-
}
-
-
return -1;
-
}
-
-
/* FIXME: This function probably doesn't do what it is intended to do
-
* if the last inherit had inherits of its own. Consider removal.
-
*/
-
void rename_last_inherit(struct pike_string *n)
-
{
-
if(Pike_compiler->new_program->inherits[Pike_compiler->new_program->num_inherits].name)
-
free_string(Pike_compiler->new_program->inherits[Pike_compiler->new_program->num_inherits].name);
-
copy_shared_string(Pike_compiler->new_program->inherits[Pike_compiler->new_program->num_inherits].name,
-
n);
-
}
-
-
#if 0
-
static int locate_parent_state(struct program_state **state,
-
struct inherit **i,
-
int *parent_identifier,
-
int depth)
-
{
-
int result=1;
-
if(depth<=0) return depth;
-
while(depth-->0)
-
{
-
if( (*i)->parent_offset != INHERIT_PARENT)
-
{
-
int tmp=(*i)->parent_identifier;
-
if( (*i)->parent_offset > 0)
-
{
-
int po=(*i)->parent_offset;
-
*parent_identifier = (*state)->parent_identifier;
-
*state = (*state)->previous;
-
result++;
-
fprintf(stderr,"INHERIT: state=state->previous (po=%d)\n",po);
-
-
if(po>1)
-
{
-
*i=INHERIT_FROM_INT( (*state)->new_program,
-
*parent_identifier);
-
-
result+=locate_parent_state(state,i,parent_identifier, po-1);
-
}
-
}
-
-
if(tmp != -1)
-
{
-
if( *parent_identifier == -4711)
-
{
-
*parent_identifier = tmp;
-
}else{
-
*parent_identifier = tmp + INHERIT_FROM_INT( (*state)->new_program,
-
*parent_identifier)->identifier_level;
-
}
-
}
-
}else{
-
fprintf(stderr,"INHERIT: Bailout!\n");
-
return result+depth+1;
-
}
-
*i = INHERIT_FROM_INT( (*state)->new_program, *parent_identifier);
-
}
-
return result;
-
}
-
-
-
static int find_depth(struct program_state *state,
-
struct inherit *i,
-
int parent_identifier,
-
int depth)
-
{
-
#if 0
-
int e;
-
struct inherit *oi;
-
for(e=0;e<=parent_offset;e++) state=state->previous;
-
oi=INHERIT_FROM_INT(state->new_program, parent_identifier);
-
parent_offset+=i->parent_offset;
-
#endif
-
-
return locate_parent_state(&state,
-
&i,
-
&parent_identifier,
-
depth);
-
}
-
#endif
-
-
#ifdef WITH_FACETS
-
void check_for_facet_inherit(struct program *p)
-
{
-
/* If the inherit statement comes before the facet keyword in the
-
* class declaration the class will be temporarily marked as a
-
* product-class, but this will be taken care of when the facet
-
* keyword is found. */
-
if (!p) return;
-
if (Pike_compiler->new_program->facet_group &&
-
p->facet_group != Pike_compiler->new_program->facet_group)
-
yyerror("A class can not belong to two facet-groups.");
-
if (p->flags & PROGRAM_IS_FACET) {
-
if (Pike_compiler->new_program->flags & PROGRAM_IS_FACET) {
-
if(Pike_compiler->new_program->facet_index != p->facet_index)
-
yyerror("Facet class can't inherit from class in different facet.");
-
}
-
/* Otherwise this is a product class */
-
else {
-
if( !Pike_compiler->new_program->facet_group ) {
-
Pike_compiler->new_program->flags |= PROGRAM_IS_PRODUCT;
-
add_ref(p->facet_group);
-
Pike_compiler->new_program->facet_group = p->facet_group;
-
}
-
push_int(Pike_compiler->new_program->id);
-
push_int(p->facet_index);
-
push_int(p->id);
-
safe_apply(p->facet_group, "add_product_class", 3);
-
pop_stack();
-
}
-
}
-
/* The inherited class is not a facet class */
-
else if (p->flags & PROGRAM_IS_PRODUCT) {
-
if (Pike_compiler->new_program->flags & PROGRAM_IS_FACET) {
-
yyerror("Facet class can't inherit from product class.");
-
}
-
else if(Pike_compiler->new_program->flags & PROGRAM_IS_PRODUCT){
-
yyerror("Product class can't inherit from other product class.");
-
}
-
/* A class that inherits from a product class is also a product class */
-
else {
-
Pike_compiler->new_program->flags |= PROGRAM_IS_PRODUCT;
-
add_ref(p->facet_group);
-
Pike_compiler->new_program->facet_group = p->facet_group;
-
}
-
}
-
}
-
#endif
-
-
-
static void lower_inherit(struct program *p,
-
struct object *parent,
-
int parent_identifier,
-
int parent_offset,
-
INT32 flags,
-
struct pike_string *name)
-
{
-
int e;
-
ptrdiff_t inherit_offset, storage_offset;
-
struct inherit inherit;
-
-
#if 0
-
fprintf(stderr,"%p low_inherit(pid=%d, parent=%p, parid=%d, "
-
"paroff=%d, flags=0x%x, name=%s);\n",
-
Pike_compiler->new_program,
-
p ? p->id : 0,
-
parent,
-
parent_identifier,
-
parent_offset,
-
flags,
-
name? name->str : "");
-
#endif
-
CDFPRINTF((stderr, "th(%ld) %p inherit %p\n",
-
(long) th_self(), Pike_compiler->new_program, p));
-
-
if(!p)
-
{
-
yyerror("Illegal program pointer.");
-
return;
-
}
-
-
if (Pike_compiler->compiler_pass == 2) {
-
struct program *old_p =
-
Pike_compiler->new_program->inherits[Pike_compiler->num_inherits+1].prog;
-
Pike_compiler->num_inherits += old_p->num_inherits;
-
-
if (old_p != p) {
-
yyerror("Got different program for inherit in second pass "
-
"(resolver problem).");
-
}
-
-
if (!(p->flags & PROGRAM_FINISHED)) {
-
/* Require that the inherited program really is finished in pass
-
* 2. Otherwise we might not have all definitions when we
-
* fixate our program.
-
*
-
* FIXME: Maybe this can be relaxed by registering a dependency
-
* and delaying compilation here?
-
*/
-
yyerror ("Cannot inherit program in pass 2 "
-
"which is not fully compiled yet.");
-
yyerror ("(You probably have a cyclic symbol dependency that the "
-
"compiler cannot handle.)");
-
}
-
-
-
if(p->flags & PROGRAM_NEEDS_PARENT)
-
{
-
struct program_state *state=Pike_compiler;
-
-
if(!parent && !parent_offset)
-
{
-
yyerror("Parent pointer lost, cannot inherit!");
-
/* We've inherited it anyway, to avoid causing more errors */
-
}
-
-
#if 0
-
/* FIXME: we don't really need to set this flag on ALL
-
* previous compilations, but I'm too lazy to figure out
-
* exactly how deep down we need to go...
-
*/
-
for(e=0;e<c->compilation_depth;e++,state=state->previous)
-
state->new_program->flags |= PROGRAM_USES_PARENT;
-
#endif
-
}
-
-
return;
-
}
-
-
if (!(p->flags & (PROGRAM_FINISHED | PROGRAM_PASS_1_DONE))) {
-
yyerror ("Cannot inherit program in pass 1 "
-
"which is only a placeholder.");
-
yyerror ("(You probably have a cyclic symbol dependency that the "
-
"compiler cannot handle.)");
-
return;
-
}
-
-
#ifdef WITH_FACETS
-
/* Check if inherit is a facet inherit. */
-
check_for_facet_inherit(p);
-
#endif
-
-
if (p == placeholder_program) {
-
yyerror("Trying to inherit placeholder program (resolver problem).");
-
return;
-
}
-
-
/* parent offset was increased by 42 for above test.. */
-
if(parent_offset)
-
parent_offset-=42;
-
-
inherit_offset = Pike_compiler->new_program->num_inherits;
-
-
/* alignment magic */
-
storage_offset=p->inherits[0].storage_offset % p->alignment_needed;
-
storage_offset=low_add_storage(STORAGE_NEEDED(p),
-
p->alignment_needed,
-
storage_offset);
-
-
/* Without this, the inherit becomes skewed */
-
storage_offset-=p->inherits[0].storage_offset;
-
-
for(e=0; e<(int)p->num_inherits; e++)
-
{
-
inherit=p->inherits[e];
-
add_ref(inherit.prog);
-
inherit.identifier_level += Pike_compiler->new_program->num_identifier_references;
-
inherit.storage_offset += storage_offset;
-
inherit.inherit_level ++;
-
-
-
if(!e)
-
{
-
if(parent)
-
{
-
if(parent->next == parent)
-
{
-
#if 0
-
struct object *o;
-
inherit.parent_offset=0;
-
for(o=Pike_compiler->fake_object;o!=parent;o=o->parent)
-
{
-
#ifdef PIKE_DEBUG
-
if(!o) Pike_fatal("low_inherit with odd Pike_compiler->fake_object as parent!\n");
-
#endif
-
inherit.parent_offset++;
-
}
-
#else
-
struct program_state *state=Pike_compiler;
-
inherit.parent_offset=0;
-
for(;state->fake_object!=parent;state=state->previous)
-
{
-
#ifdef PIKE_DEBUG
-
if(!state->fake_object)
-
Pike_fatal("low_inherit with odd Pike_compiler->fake_object as parent!\n");
-
#endif
-
inherit.parent_offset++;
-
}
-
#endif
-
}else{
-
inherit.parent=parent;
-
inherit.parent_identifier=parent_identifier;
-
inherit.parent_offset=INHERIT_PARENT;
-
}
-
}else{
-
inherit.parent_offset=parent_offset;
-
inherit.parent_identifier=parent_identifier;
-
}
-
}else{
-
if(!inherit.parent)
-
{
-
if(parent && parent->next != parent && inherit.parent_offset)
-
{
-
struct object *par=parent;
-
int e,pid=parent_identifier;
-
-
for(e=1;e<inherit.parent_offset;e++)
-
{
-
struct inherit *in;
-
if(!par || !par->prog)
-
{
-
par = NULL;
-
pid = -1;
-
break;
-
}
-
-
in=INHERIT_FROM_INT(par->prog, pid);
-
switch(in->parent_offset)
-
{
-
default:
-
{
-
struct external_variable_context tmp;
-
struct inherit *in2=in;
-
while(in2->inherit_level >= in->inherit_level) in2--;
-
tmp.o=par;
-
tmp.inherit=in2;
-
tmp.parent_identifier=pid;
-
find_external_context(&tmp, in->parent_offset);
-
par = tmp.o;
-
pid = tmp.parent_identifier;
-
}
-
break;
-
-
case INHERIT_PARENT:
-
pid = in->parent_identifier;
-
par = in->parent;
-
break;
-
-
case OBJECT_PARENT:
-
/* Ponder: Can we be sure that PROGRAM_USES_PARENT
-
* doesn't get set later? /mast */
-
if(par->prog->flags & PROGRAM_USES_PARENT)
-
{
-
pid = PARENT_INFO(par)->parent_identifier;
-
par = PARENT_INFO(par)->parent;
-
}else{
-
pid = -1;
-
par = NULL;
-
}
-
}
-
}
-
-
inherit.parent=par;
-
inherit.parent_offset=INHERIT_PARENT;
-
}
-
}
-
}
-
if(inherit.parent) add_ref(inherit.parent);
-
-
if(name)
-
{
-
if(e==0)
-
{
-
copy_shared_string(inherit.name,name);
-
}
-
else if(inherit.name)
-
{
-
/* FIXME: Wide string handling. */
-
struct pike_string *s;
-
s=begin_shared_string(inherit.name->len + name->len + 2);
-
MEMCPY(s->str,name->str,name->len);
-
MEMCPY(s->str+name->len,"::",2);
-
MEMCPY(s->str+name->len+2,inherit.name->str,inherit.name->len);
-
inherit.name=end_shared_string(s);
-
}
-
else
-
{
-
inherit.name=0;
-
}
-
}else{
-
inherit.name=0;
-
}
-
add_to_inherits(inherit);
-
}
-
-
/* This value is used by encode_value() to reverse the inherit operation. */
-
Pike_compiler->new_program->inherits[inherit_offset].identifier_ref_offset =
-
Pike_compiler->new_program->num_identifier_references;
-
-
for (e=0; e < (int)p->num_identifier_references; e++)
-
{
-
struct reference fun;
-
-
fun = p->identifier_references[e]; /* Make a copy */
-
-
fun.inherit_offset += inherit_offset;
-
-
fun.run_time_type = PIKE_T_UNKNOWN; /* Invalidate the vtable cache. */
-
-
if (fun.id_flags & ID_FINAL)
-
{
-
Pike_compiler->flags |= COMPILATION_CHECK_FINAL;
-
}
-
-
if(fun.id_flags & ID_PRIVATE) fun.id_flags|=ID_HIDDEN;
-
-
if (fun.id_flags & ID_PUBLIC)
-
fun.id_flags |= flags & ~ID_PRIVATE;
-
else
-
fun.id_flags |= flags;
-
-
fun.id_flags |= ID_INHERITED;
-
add_to_identifier_references(fun);
-
}
-
}
-
-
/*
-
* make this program inherit another program
-
*/
-
PMOD_EXPORT void low_inherit(struct program *p,
-
struct object *parent,
-
int parent_identifier,
-
int parent_offset,
-
INT32 flags,
-
struct pike_string *name)
-
{
-
lower_inherit(p, parent, parent_identifier, parent_offset, flags, name);
-
-
/* Don't do this for OBJECT_PARENT or INHERIT_PARENT inherits.
-
* They may show up here from decode_value().
-
*/
-
if (parent_offset >= 42) {
-
if (p->flags & (PROGRAM_NEEDS_PARENT|PROGRAM_USES_PARENT)) {
-
/* We'll need the parent pointer as well... */
-
struct program_state *state = Pike_compiler;
-
-
/* parent offset was increased by 42 by the caller... */
-
parent_offset -= 42;
-
-
while (state && state->new_program && parent_offset--) {
-
state->new_program->flags |= PROGRAM_NEEDS_PARENT|PROGRAM_USES_PARENT;
-
state = state->previous;
-
}
-
}
-
}
-
}
-
-
PMOD_EXPORT void do_inherit(struct svalue *s,
-
INT32 flags,
-
struct pike_string *name)
-
{
-
struct object *parent_obj = NULL;
-
int parent_id = -1;
-
struct program *p = low_program_from_svalue(s, &parent_obj, &parent_id);
-
low_inherit(p, parent_obj, parent_id, 0, flags, name);
-
}
-
-
void compiler_do_inherit(node *n,
-
INT32 flags,
-
struct pike_string *name)
-
{
-
struct program *p;
-
struct identifier *i;
-
INT32 numid=-1, offset=0;
-
-
if(!n)
-
{
-
yyerror("Unable to inherit");
-
return;
-
}
-
-
switch(n->token)
-
{
-
case F_IDENTIFIER:
-
p=Pike_compiler->new_program;
-
offset=0;
-
numid=n->u.id.number;
-
goto continue_inherit;
-
-
case F_EXTERNAL:
-
{
-
struct program_state *state = Pike_compiler;
-
-
offset = 0;
-
while (state && (state->new_program->id != n->u.integer.a)) {
-
state = state->previous;
-
offset++;
-
}
-
if (!state) {
-
yyerror("Failed to resolv external constant.\n");
-
return;
-
}
-
p = state->new_program;
-
numid = n->u.integer.b;
-
}
-
-
continue_inherit:
-
-
/* FIXME: Support external constants. */
-
if(numid != IDREF_MAGIC_THIS &&
-
(IDENTIFIER_IS_CONSTANT((i=ID_FROM_INT(p, numid))->
-
identifier_flags)) &&
-
(i->func.const_info.offset != -1))
-
{
-
struct svalue *s=&PROG_FROM_INT(p, numid)->
-
constants[i->func.const_info.offset].sval;
-
if(TYPEOF(*s) != T_PROGRAM)
-
{
-
do_inherit(s,flags,name);
-
return;
-
}else{
-
low_inherit(s->u.program,
-
0,
-
numid,
-
offset+42,
-
flags,
-
name);
-
}
-
}else{
-
yyerror("Inherit identifier is not a constant program");
-
return;
-
}
-
break;
-
-
default:
-
resolv_class(n);
-
do_inherit(Pike_sp-1, flags, name);
-
pop_stack();
-
}
-
}
-
-
int call_handle_inherit(struct pike_string *s)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
-
CHECK_COMPILER();
-
-
ref_push_string(s);
-
if (!TEST_COMPAT(7,6)) {
-
/* In Pike 7.7 and later filenames belonging to Pike are assumed
-
* to be encoded according to UTF-8.
-
*/
-
f_string_to_utf8(1);
-
}
-
-
if (safe_apply_current2(PC_HANDLE_INHERIT_FUN_NUM, 1, NULL))
-
if (TYPEOF(Pike_sp[-1]) != T_INT)
-
return 1;
-
else {
-
my_yyerror("Couldn't find program %S", s);
-
}
-
else {
-
handle_compile_exception ("Error finding program");
-
}
-
pop_stack();
-
-
return 0;
-
}
-
-
void simple_do_inherit(struct pike_string *s,
-
INT32 flags,
-
struct pike_string *name)
-
{
-
if (!call_handle_inherit(s)) return;
-
-
if(name)
-
{
-
free_string(s);
-
s=name;
-
}
-
do_inherit(Pike_sp-1, flags, s);
-
free_string(s);
-
pop_stack();
-
}
-
-
/*
-
* Return the index of the identifier found, otherwise -1.
-
*/
-
int isidentifier(struct pike_string *s)
-
{
-
return really_low_find_shared_string_identifier(s,
-
Pike_compiler->new_program,
-
SEE_PROTECTED|SEE_PRIVATE);
-
}
-
-
/**
-
* Return the index of the identifier if found, otherwise -1.
-
*
-
* If id_flags indicates a variant function, the index for a
-
* variant function with the same type and name is returned
-
* if found, otherwise -1.
-
*/
-
int isidentifier_variant(struct pike_string *name,
-
unsigned id_flags,
-
struct pike_type *type)
-
{
-
if (id_flags & ID_VARIANT) {
-
return really_low_find_variant_identifier(name,
-
Pike_compiler->new_program,
-
type,
-
Pike_compiler->new_program->
-
num_identifier_references,
-
SEE_PROTECTED|SEE_PRIVATE);
-
} else {
-
return isidentifier(name);
-
}
-
}
-
-
/*
-
* Definition of identifiers.
-
*
-
* Pike has three plus one classes of identifiers:
-
*
-
* IDENTIFIER_VARIABLE - A value stored in object->storage
-
* IDENTIFIER_CONSTANT - A value stored in program->constants
-
* IDENTIFIER_FUNCTION - Either a C function or a Pike function
-
* and
-
* IDENTIFIER_ALIAS - An alias for a different identifier.
-
*
-
*/
-
-
-
/* Define an alias for a (possibly extern) identifier.
-
*
-
* Note that both type and name may be NULL. If they are NULL
-
* they will be defaulted to the values from the aliased identifier.
-
*/
-
int low_define_alias(struct pike_string *name, struct pike_type *type,
-
int flags, int depth, int refno)
-
{
-
int n;
-
int e;
-
-
struct compilation *c = THIS_COMPILATION;
-
struct program_state *state = Pike_compiler;
-
struct identifier dummy, *id;
-
struct reference ref;
-
-
#ifdef PIKE_DEBUG
-
if(Pike_compiler->new_program->flags & (PROGRAM_FIXED | PROGRAM_OPTIMIZED))
-
Pike_fatal("Attempting to add variable to fixed program\n");
-
-
if(Pike_compiler->compiler_pass==2)
-
Pike_fatal("Internal error: Not allowed to add more identifiers during second compiler pass.\n"
-
"Added identifier: \"%s\"\n", name->str);
-
#endif
-
-
for(e = 0; state && (e < depth); e++) {
-
state = state->previous;
-
}
-
-
#ifdef PIKE_DEBUG
-
if (!state) {
-
Pike_fatal("Internal error: External symbol buried too deep.\n");
-
}
-
if (state->new_program->num_identifier_references <= refno) {
-
Pike_fatal("Internal error: Reference out of bounds: %d (max: %d).\n",
-
refno, state->new_program->num_identifier_references);
-
}
-
#endif
-
-
id = ID_FROM_INT(state->new_program, refno);
-
-
if (name) {
-
copy_shared_string(dummy.name, name);
-
} else {
-
copy_shared_string(dummy.name, id->name);
-
}
-
if (type) {
-
copy_pike_type(dummy.type, type);
-
} else {
-
copy_pike_type(dummy.type, id->type);
-
}
-
dummy.filename_strno = store_prog_string(c->lex.current_file);
-
dummy.linenumber = c->lex.current_line;
-
dummy.identifier_flags = id->identifier_flags | IDENTIFIER_ALIAS;
-
dummy.run_time_type = id->run_time_type; /* Not actually used. */
-
dummy.func.ext_ref.depth = depth;
-
dummy.func.ext_ref.id = refno;
-
dummy.opt_flags = 0;
-
#ifdef PROFILING
-
dummy.self_time=0;
-
dummy.num_calls=0;
-
dummy.recur_depth=0;
-
dummy.total_time=0;
-
#endif
-
-
if (flags & ID_PRIVATE) flags |= ID_INLINE;
-
-
ref.id_flags=flags;
-
ref.identifier_offset=Pike_compiler->new_program->num_identifiers;
-
ref.inherit_offset=0;
-
ref.run_time_type = PIKE_T_UNKNOWN;
-
-
debug_add_to_identifiers(dummy);
-
-
n = Pike_compiler->new_program->num_identifier_references;
-
add_to_identifier_references(ref);
-
-
return n;
-
}
-
-
PMOD_EXPORT int define_alias(struct pike_string *name, struct pike_type *type,
-
int flags, int depth, int refno)
-
{
-
/* FIXME: Support NULL name and type. */
-
int n = isidentifier(name);
-
-
if(Pike_compiler->new_program->flags & PROGRAM_PASS_1_DONE)
-
{
-
if(n==-1)
-
yyerror("Pass2: Alias disappeared!");
-
else {
-
struct identifier *id = ID_FROM_INT(Pike_compiler->new_program, n);
-
if (!IDENTIFIER_IS_ALIAS(id->identifier_flags)) {
-
if (IDENTIFIER_IS_CONSTANT(id->identifier_flags)) {
-
/* Convert a placeholder constant into an alias. */
-
struct program_state *state = Pike_compiler;
-
int e;
-
-
for(e = 0; state && (e < depth); e++) {
-
state = state->previous;
-
}
-
-
#ifdef PIKE_DEBUG
-
if (!state) {
-
Pike_fatal("Internal error: External symbol buried too deep.\n");
-
}
-
if (state->new_program->num_identifier_references <= refno) {
-
Pike_fatal("Internal error: Reference out of bounds: %d (max: %d).\n",
-
refno, state->new_program->num_identifier_references);
-
}
-
#endif
-
-
id->identifier_flags = IDENTIFIER_ALIAS |
-
ID_FROM_INT(state->new_program, refno)->identifier_flags;
-
} else {
-
Pike_fatal("Replacing non alias with an alias in second pass!\n");
-
}
-
}
-
-
free_type(id->type);
-
copy_pike_type(id->type, type);
-
id->func.ext_ref.depth = depth;
-
id->func.ext_ref.id = refno;
-
return n;
-
}
-
}
-
-
#ifdef PIKE_DEBUG
-
if(Pike_compiler->new_program->flags & (PROGRAM_FIXED | PROGRAM_OPTIMIZED))
-
Pike_fatal("Attempting to add variable to fixed program\n");
-
#endif
-
-
if(n != -1)
-
{
-
/* not inherited */
-
if(Pike_compiler->new_program->identifier_references[n].inherit_offset == 0)
-
{
-
if (!((IDENTIFIERP(n)->id_flags | flags) & ID_EXTERN)) {
-
my_yyerror("Identifier %S defined twice.",name);
-
return n;
-
}
-
if (flags & ID_EXTERN) {
-
/* FIXME: Check type */
-
return n;
-
}
-
}
-
-
if (!(IDENTIFIERP(n)->id_flags & ID_EXTERN)) {
-
if (IDENTIFIERP(n)->id_flags & ID_FINAL)
-
my_yyerror("Illegal to redefine 'final' "
-
"variable/functions %S", name);
-
-
/* FIXME: More. */
-
}
-
}
-
-
return low_define_alias(name, type, flags, depth, refno);
-
}
-
-
/* argument must be a shared string */
-
int low_define_variable(struct pike_string *name,
-
struct pike_type *type,
-
INT32 flags,
-
size_t offset,
-
INT32 run_time_type)
-
{
-
int n;
-
-
struct compilation *c = THIS_COMPILATION;
-
struct identifier dummy;
-
struct reference ref;
-
-
#ifdef PIKE_DEBUG
-
if(Pike_compiler->new_program->flags & (PROGRAM_FIXED | PROGRAM_OPTIMIZED))
-
Pike_fatal("Attempting to add variable to fixed program\n");
-
-
if(Pike_compiler->compiler_pass==2)
-
Pike_fatal("Internal error: Not allowed to add more identifiers during second compiler pass.\n"
-
"Added identifier: \"%s\"\n", name->str);
-
#endif
-
-
copy_shared_string(dummy.name, name);
-
copy_pike_type(dummy.type, type);
-
dummy.filename_strno = store_prog_string(c->lex.current_file);
-
dummy.linenumber = c->lex.current_line;
-
dummy.identifier_flags = IDENTIFIER_VARIABLE;
-
dummy.run_time_type=run_time_type;
-
dummy.func.offset=offset - Pike_compiler->new_program->inherits[0].storage_offset;
-
dummy.opt_flags = 0;
-
#ifdef PROFILING
-
dummy.self_time=0;
-
dummy.num_calls=0;
-
dummy.recur_depth=0;
-
dummy.total_time=0;
-
#endif
-
-
if (run_time_type == PIKE_T_FREE) dummy.func.offset = -1;
-
-
if (flags & ID_PRIVATE) flags |= ID_LOCAL|ID_PROTECTED;
-
-
ref.id_flags=flags;
-
ref.identifier_offset=Pike_compiler->new_program->num_identifiers;
-
ref.inherit_offset=0;
-
ref.run_time_type = PIKE_T_UNKNOWN;
-
-
add_to_variable_index(ref.identifier_offset);
-
-
debug_add_to_identifiers(dummy);
-
-
n=Pike_compiler->new_program->num_identifier_references;
-
add_to_identifier_references(ref);
-
-
return n;
-
}
-
-
/* type is a textual type */
-
PMOD_EXPORT int map_variable(const char *name,
-
const char *type,
-
INT32 flags,
-
size_t offset,
-
INT32 run_time_type)
-
{
-
int ret;
-
struct pike_string *n;
-
struct pike_type *t;
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
struct compilation *c = THIS_COMPILATION;
-
fprintf (stderr, "%.*sdefining variable (pass=%d): %s %s\n",
-
c->compilation_depth, "",
-
Pike_compiler->compiler_pass, type, name);
-
#endif
-
-
n=make_shared_string(name);
-
t=parse_type(type);
-
ret=low_define_variable(n,t,flags|ID_USED,offset,run_time_type);
-
free_string(n);
-
free_type(t);
-
return ret;
-
}
-
-
/* type is a serialized tokenized type. */
-
PMOD_EXPORT int quick_map_variable(const char *name,
-
int name_length,
-
size_t offset,
-
const char *type,
-
int UNUSED(type_length),
-
INT32 run_time_type,
-
INT32 flags)
-
{
-
int ret;
-
struct pike_string *n;
-
struct pike_type *t;
-
-
n = make_shared_binary_string(name, name_length);
-
t = make_pike_type(type);
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct pike_string *d = describe_type (t);
-
fprintf (stderr, "%.*sdefining variable (pass=%d): %s ",
-
c->compilation_depth, "", Pike_compiler->compiler_pass, d->str);
-
free_string (d);
-
push_string (n);
-
print_svalue (stderr, --Pike_sp);
-
putc ('\n', stderr);
-
}
-
#endif
-
-
ret=low_define_variable(n,t,flags|ID_USED,offset,run_time_type);
-
free_string(n);
-
free_type(t);
-
return ret;
-
}
-
-
/* argument must be a shared string */
-
int define_variable(struct pike_string *name,
-
struct pike_type *type,
-
INT32 flags)
-
{
-
int n, run_time_type;
-
-
#ifdef PIKE_DEBUG
-
if(name!=debug_findstring(name))
-
Pike_fatal("define_variable on nonshared string.\n");
-
#endif
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct pike_string *d = describe_type (type);
-
fprintf (stderr, "%.*sdefining variable (pass=%d): %s ",
-
c->compilation_depth, "", Pike_compiler->compiler_pass, d->str);
-
free_string (d);
-
push_string (name);
-
print_svalue (stderr, --Pike_sp);
-
putc ('\n', stderr);
-
}
-
#endif
-
-
if(type == void_type_string)
-
yyerror("Variables can't be of type void.");
-
-
n = isidentifier(name);
-
-
if(Pike_compiler->new_program->flags & PROGRAM_PASS_1_DONE)
-
{
-
if(n==-1)
-
yyerror("Pass2: Variable disappeared!");
-
else {
-
struct identifier *id=ID_FROM_INT(Pike_compiler->new_program,n);
-
free_type(id->type);
-
copy_pike_type(id->type, type);
-
return n;
-
}
-
}
-
-
#ifdef PIKE_DEBUG
-
if(Pike_compiler->new_program->flags & (PROGRAM_FIXED | PROGRAM_OPTIMIZED))
-
Pike_fatal("Attempting to add variable to fixed program\n");
-
#endif
-
-
if(n != -1)
-
{
-
/* not inherited */
-
if(Pike_compiler->new_program->identifier_references[n].inherit_offset == 0)
-
{
-
if (!((IDENTIFIERP(n)->id_flags | flags) & ID_EXTERN)) {
-
my_yyerror("Identifier %S defined twice.",name);
-
return n;
-
}
-
if (flags & ID_EXTERN) {
-
/* FIXME: Check type */
-
return n;
-
}
-
}
-
-
if (!(IDENTIFIERP(n)->id_flags & ID_EXTERN)) {
-
if (IDENTIFIERP(n)->id_flags & ID_FINAL)
-
my_yyerror("Illegal to redefine 'final' "
-
"variable/functions %S", name);
-
-
if(!(IDENTIFIERP(n)->id_flags & ID_INLINE) ||
-
Pike_compiler->compiler_pass!=1)
-
{
-
int n2;
-
-
if(ID_FROM_INT(Pike_compiler->new_program, n)->type != type &&
-
!pike_types_le(type,
-
ID_FROM_INT(Pike_compiler->new_program, n)->type)) {
-
int level = REPORT_WARNING;
-
if (!match_types(ID_FROM_INT(Pike_compiler->new_program, n)->type,
-
type)) {
-
level = REPORT_ERROR;
-
}
-
yytype_report(level, NULL, 0,
-
ID_FROM_INT(Pike_compiler->new_program, n)->type,
-
NULL, 0, type, 0,
-
"Illegal to redefine inherited variable %S "
-
"with different type.", name);
-
}
-
-
-
if(!IDENTIFIER_IS_VARIABLE(ID_FROM_INT(Pike_compiler->new_program, n)->
-
identifier_flags))
-
{
-
my_yyerror("Illegal to redefine inherited symbol %S "
-
"as a variable.", name);
-
return n;
-
}
-
-
if ((ID_FROM_INT(Pike_compiler->new_program, n)->run_time_type !=
-
PIKE_T_MIXED) &&
-
(ID_FROM_INT(Pike_compiler->new_program, n)->run_time_type !=
-
compile_type_to_runtime_type(type))) {
-
yytype_report(REPORT_ERROR, NULL, 0,
-
ID_FROM_INT(Pike_compiler->new_program, n)->type,
-
NULL, 0, type, 0,
-
"Illegal to redefine inherited variable %S "
-
"with different type.", name);
-
return n;
-
}
-
-
/* Create an alias for the old variable reference, so that we
-
* can change the compile-time type. */
-
n2 = define_alias(name, type, flags & ~ID_EXTERN, 0, n);
-
-
/* Hide the old variable. */
-
Pike_compiler->new_program->identifier_references[n].id_flags |=
-
ID_HIDDEN;
-
return n2;
-
} else if ((IDENTIFIERP(n)->id_flags & (ID_INLINE|ID_INHERITED)) ==
-
(ID_INLINE|ID_INHERITED)) {
-
/* Hide the overloaded inherited symbol. */
-
IDENTIFIERP(n)->id_flags |= ID_HIDDEN;
-
}
-
} else if ((IDENTIFIERP(n)->id_flags & (ID_EXTERN|ID_INHERITED)) ==
-
(ID_EXTERN|ID_INHERITED)) {
-
/* Hide the overloaded inherited symbol. */
-
IDENTIFIERP(n)->id_flags |= ID_STATIC|ID_PRIVATE|ID_USED;
-
}
-
}
-
-
if (flags & ID_EXTERN) {
-
run_time_type = PIKE_T_FREE;
-
} else {
-
run_time_type=compile_type_to_runtime_type(type);
-
-
switch(run_time_type)
-
{
-
#ifdef AUTO_BIGNUM
-
case T_INT:
-
#endif
-
case T_OBJECT:
-
/* Make place for the object subtype. */
-
case T_FUNCTION:
-
case T_PROGRAM:
-
run_time_type = T_MIXED;
-
}
-
}
-
-
n=low_define_variable(name,type,flags,
-
low_add_storage(sizeof_variable(run_time_type),
-
alignof_variable(run_time_type),0),
-
run_time_type);
-
-
ID_FROM_INT(Pike_compiler->new_program, n)->identifier_flags |= IDENTIFIER_NO_THIS_REF;
-
-
return n;
-
}
-
-
PMOD_EXPORT int simple_add_variable(const char *name,
-
const char *type,
-
INT32 flags)
-
{
-
INT32 ret;
-
struct pike_string *name_s;
-
struct pike_type *type_s;
-
name_s = make_shared_string(name);
-
type_s = parse_type(type);
-
-
ret=define_variable(name_s, type_s, flags);
-
free_string(name_s);
-
free_type(type_s);
-
return ret;
-
}
-
-
PMOD_EXPORT int add_constant(struct pike_string *name,
-
const struct svalue *c,
-
INT32 flags)
-
{
-
int n;
-
struct compilation *cc = THIS_COMPILATION;
-
struct identifier dummy;
-
struct reference ref;
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
{
-
if (c) {
-
struct pike_type *t = get_type_of_svalue(c);
-
struct pike_string *d = describe_type (t);
-
fprintf (stderr, "%.*sdefining constant (pass=%d): %s ",
-
cc->compilation_depth, "",
-
Pike_compiler->compiler_pass, d->str);
-
free_type(t);
-
free_string (d);
-
push_string (name);
-
print_svalue (stderr, --Pike_sp);
-
fputs (" = ", stderr);
-
print_svalue (stderr, c);
-
}
-
else {
-
fprintf (stderr, "%.*sdeclaring constant (pass=%d): ",
-
cc->compilation_depth, "",
-
Pike_compiler->compiler_pass);
-
push_string (name);
-
print_svalue (stderr, --Pike_sp);
-
}
-
putc ('\n', stderr);
-
}
-
#endif
-
-
#if 0
-
if (!c) {
-
c = &svalue_int_zero;
-
}
-
#endif
-
-
#ifdef PIKE_DEBUG
-
if(name!=debug_findstring(name))
-
Pike_fatal("define_constant on nonshared string.\n");
-
if (c) {
-
check_svalue (c);
-
if (TYPEOF(*c) > MAX_TYPE)
-
/* check_svalue allows some things like T_SVALUE_PTR. */
-
Pike_fatal ("Invalid type in svalue: %d\n", TYPEOF(*c));
-
}
-
#endif
-
-
n = isidentifier(name);
-
-
if(
-
#if 1
-
c &&
-
#endif
-
TYPEOF(*c) == T_FUNCTION &&
-
SUBTYPEOF(*c) != FUNCTION_BUILTIN &&
-
c->u.object->prog)
-
{
-
struct program_state *state = Pike_compiler;
-
struct reference *idref = PTR_FROM_INT(c->u.object->prog, SUBTYPEOF(*c));
-
struct program *p = PROG_FROM_PTR(c->u.object->prog, idref);
-
struct identifier *id = p->identifiers + idref->identifier_offset;
-
int depth = 0;
-
while (state && (c->u.object->prog != state->new_program)) {
-
depth++;
-
state = state->previous;
-
}
-
if(state) {
-
/* Alias for a symbol in the current or surrounding programs.
-
*/
-
if(IDENTIFIER_IS_CONSTANT(id->identifier_flags) &&
-
(id->func.const_info.offset != -1) &&
-
(state == Pike_compiler)) {
-
c=& p->constants[id->func.const_info.offset].sval;
-
} else if (IDENTIFIER_IS_VARIABLE(id->identifier_flags) &&
-
(state == Pike_compiler)) {
-
my_yyerror("Attempt to make a constant %S of a variable.",
-
name);
-
c = NULL;
-
} else {
-
/* Alias for a function or a variable or constant in a surrounding
-
* scope.
-
*/
-
int n = SUBTYPEOF(*c);
-
struct reference *remote_ref = PTR_FROM_INT(state->new_program, n);
-
if (!(remote_ref->id_flags & (ID_INLINE|ID_HIDDEN))) {
-
/* We need to get a suitable reference. */
-
n = really_low_reference_inherited_identifier(state, 0, n);
-
}
-
return define_alias(name, id->type, flags, depth, n);
-
}
-
}
-
}
-
-
if(
-
#if 1
-
c &&
-
#endif
-
!svalues_are_constant(c,1,BIT_MIXED,0))
-
my_yyerror("Constant value %S has a reference to this.", name);
-
-
if(Pike_compiler->new_program->flags & PROGRAM_PASS_1_DONE)
-
{
-
if(n==-1
-
#if 1
-
|| !c
-
#endif
-
)
-
{
-
yyerror("Pass2: Constant disappeared!");
-
}else{
-
struct identifier *id;
-
id=ID_FROM_INT(Pike_compiler->new_program,n);
-
if(id->func.const_info.offset>=0) {
-
/* Update the stored constant. */
-
assign_svalue (&PROG_FROM_INT(Pike_compiler->new_program,n)->
-
constants[id->func.const_info.offset].sval, c);
-
} else {
-
id->run_time_type = (unsigned char) TYPEOF(*c);
-
id->func.const_info.offset = store_constant(c, 0, 0);
-
}
-
free_type(id->type);
-
if ((TYPEOF(*c) == T_INT) && !(flags & ID_INLINE)) {
-
if (c->u.integer) {
-
copy_pike_type(id->type, int_type_string);
-
} else {
-
copy_pike_type(id->type, zero_type_string);
-
}
-
} else {
-
id->type = get_type_of_svalue(c);
-
}
-
#ifdef PROGRAM_BUILD_DEBUG
-
fprintf (stderr, "%.*sstored constant #%d at %d\n",
-
cc->compilation_depth, "",
-
n, id->func.const_info.offset);
-
#endif
-
}
-
return n;
-
}
-
-
#ifdef PIKE_DEBUG
-
if(Pike_compiler->new_program->flags & (PROGRAM_FIXED | PROGRAM_OPTIMIZED))
-
Pike_fatal("Attempting to add constant to fixed program\n");
-
-
if(Pike_compiler->compiler_pass==2) {
-
dump_program_tables(Pike_compiler->new_program, 2);
-
Pike_fatal("Internal error: Not allowed to add more identifiers during second compiler pass.\n"
-
" Attempted to add the identifier \"%s\"\n",
-
name->str);
-
}
-
#endif
-
-
copy_shared_string(dummy.name, name);
-
dummy.identifier_flags = IDENTIFIER_CONSTANT;
-
dummy.filename_strno = store_prog_string(cc->lex.current_file);
-
dummy.linenumber = cc->lex.current_line;
-
-
#if 1
-
if (c) {
-
#endif
-
if ((TYPEOF(*c) == T_INT) && !(flags & ID_INLINE)) {
-
if (c->u.integer) {
-
copy_pike_type(dummy.type, int_type_string);
-
} else {
-
copy_pike_type(dummy.type, zero_type_string);
-
}
-
} else {
-
dummy.type = get_type_of_svalue(c);
-
}
-
dummy.run_time_type = (unsigned char) TYPEOF(*c);
-
dummy.func.const_info.offset = store_constant(c, 0, 0);
-
dummy.opt_flags=OPT_SIDE_EFFECT | OPT_EXTERNAL_DEPEND;
-
if(TYPEOF(*c) == PIKE_T_PROGRAM && (c->u.program->flags & PROGRAM_CONSTANT))
-
dummy.opt_flags=0;
-
#if 1
-
}
-
else {
-
copy_pike_type(dummy.type, mixed_type_string);
-
dummy.run_time_type=T_MIXED;
-
dummy.func.const_info.offset = -1;
-
dummy.opt_flags=0;
-
}
-
#endif
-
-
if (flags & ID_PRIVATE) flags |= ID_LOCAL|ID_PROTECTED;
-
-
ref.id_flags=flags;
-
ref.identifier_offset=Pike_compiler->new_program->num_identifiers;
-
ref.inherit_offset=0;
-
ref.run_time_type = PIKE_T_UNKNOWN;
-
-
#ifdef PROFILING
-
dummy.self_time=0;
-
dummy.num_calls=0;
-
dummy.recur_depth=0;
-
dummy.total_time=0;
-
#endif
-
-
debug_add_to_identifiers(dummy);
-
-
if(n != -1)
-
{
-
int overridden;
-
-
if(IDENTIFIERP(n)->id_flags & ID_FINAL)
-
my_yyerror("Illegal to redefine 'final' identifier %S", name);
-
-
if(!TEST_COMPAT(7,2) &&
-
IDENTIFIER_IS_VARIABLE(ID_FROM_INT(Pike_compiler->new_program,
-
n)->identifier_flags))
-
{
-
my_yyerror("Illegal to redefine variable %S as constant.", name);
-
}
-
-
/* not inherited */
-
if(Pike_compiler->new_program->identifier_references[n].inherit_offset == 0)
-
{
-
my_yyerror("Identifier %S defined twice.", name);
-
return n;
-
}
-
-
/* override */
-
if ((overridden = override_identifier (&ref, name)) >= 0) {
-
#ifdef PIKE_DEBUG
-
struct reference *oref =
-
Pike_compiler->new_program->identifier_references+overridden;
-
if((oref->inherit_offset != ref.inherit_offset) ||
-
(oref->identifier_offset != ref.identifier_offset) ||
-
((oref->id_flags | ID_USED) != (ref.id_flags | ID_USED))) {
-
Pike_fatal("New constant overriding algorithm failed!\n");
-
}
-
#endif
-
return overridden;
-
}
-
}
-
n=Pike_compiler->new_program->num_identifier_references;
-
add_to_identifier_references(ref);
-
-
return n;
-
}
-
-
PMOD_EXPORT int simple_add_constant(const char *name,
-
struct svalue *c,
-
INT32 flags)
-
{
-
INT32 ret;
-
struct pike_string *id;
-
id=make_shared_string(name);
-
ret=add_constant(id, c, flags);
-
free_string(id);
-
return ret;
-
}
-
-
PMOD_EXPORT int add_integer_constant(const char *name,
-
INT_ARG_TYPE i,
-
INT32 flags)
-
{
-
struct svalue tmp;
-
SET_SVAL(tmp, T_INT, NUMBER_NUMBER, integer, i);
-
return simple_add_constant(name, &tmp, flags);
-
}
-
-
PMOD_EXPORT int low_add_integer_constant(struct pike_string *name,
-
INT_ARG_TYPE i,
-
INT32 flags)
-
{
-
struct svalue tmp;
-
SET_SVAL(tmp, T_INT, NUMBER_NUMBER, integer, i);
-
return add_constant(name, &tmp, flags);
-
}
-
-
PMOD_EXPORT int quick_add_integer_constant(const char *name,
-
int name_length,
-
INT_ARG_TYPE i,
-
INT32 flags)
-
{
-
INT32 ret;
-
struct pike_string *n = make_shared_binary_string(name, name_length);
-
ret=low_add_integer_constant(n, i, flags);
-
free_string(n);
-
return ret;
-
}
-
-
PMOD_EXPORT int add_float_constant(const char *name,
-
FLOAT_ARG_TYPE f,
-
INT32 flags)
-
{
-
struct svalue tmp;
-
SET_SVAL(tmp, T_FLOAT, 0, float_number, (FLOAT_TYPE)f);
-
return simple_add_constant(name, &tmp, flags);
-
}
-
-
PMOD_EXPORT int quick_add_float_constant(const char *name,
-
int name_length,
-
FLOAT_ARG_TYPE f,
-
INT32 flags)
-
{
-
struct svalue tmp;
-
struct pike_string *id;
-
INT32 ret;
-
-
SET_SVAL(tmp, T_FLOAT, 0, float_number, (FLOAT_TYPE)f);
-
id=make_shared_binary_string(name,name_length);
-
ret=add_constant(id, &tmp, flags);
-
free_string(id);
-
return ret;
-
}
-
-
PMOD_EXPORT int add_string_constant(const char *name,
-
const char *str,
-
INT32 flags)
-
{
-
INT32 ret;
-
struct svalue tmp;
-
SET_SVAL(tmp, T_STRING, 0, string, make_shared_string(str));
-
ret=simple_add_constant(name, &tmp, flags);
-
free_svalue(&tmp);
-
return ret;
-
}
-
-
PMOD_EXPORT int add_program_constant(const char *name,
-
struct program *p,
-
INT32 flags)
-
{
-
INT32 ret;
-
struct svalue tmp;
-
if (p) {
-
SET_SVAL(tmp, T_PROGRAM, 0, program, p);
-
} else {
-
/* Probable compilation error in a C-module. */
-
SET_SVAL(tmp, T_INT, NUMBER_UNDEFINED, integer, 0);
-
my_yyerror("Program constant \"%s\" is NULL.", name);
-
}
-
ret=simple_add_constant(name, &tmp, flags);
-
return ret;
-
}
-
-
PMOD_EXPORT int add_object_constant(const char *name,
-
struct object *o,
-
INT32 flags)
-
{
-
INT32 ret;
-
struct svalue tmp;
-
SET_SVAL(tmp, T_OBJECT, 0, object, o);
-
ret=simple_add_constant(name, &tmp, flags);
-
return ret;
-
}
-
-
PMOD_EXPORT int add_function_constant(const char *name, void (*cfun)(INT32),
-
const char * type, int flags)
-
{
-
struct svalue s;
-
INT32 ret;
-
-
SET_SVAL(s, T_FUNCTION, FUNCTION_BUILTIN, efun,
-
make_callable(cfun, name, type, flags, 0, 0));
-
ret=simple_add_constant(name, &s, 0);
-
free_svalue(&s);
-
return ret;
-
}
-
-
-
PMOD_EXPORT int debug_end_class(const char *name, ptrdiff_t namelen, INT32 flags)
-
{
-
INT32 ret;
-
struct svalue tmp;
-
struct pike_string *id;
-
-
SET_SVAL(tmp, T_PROGRAM, 0, program, end_program());
-
if(!tmp.u.program)
-
Pike_fatal("Failed to initialize class '%s'\n",name);
-
-
id=make_shared_binary_string(name,namelen);
-
ret=add_constant(id, &tmp, flags);
-
/* The following is not really true, but it helps encode_value()... */
-
Pike_compiler->new_program->flags |=
-
tmp.u.program->flags & PROGRAM_HAS_C_METHODS;
-
free_string(id);
-
free_svalue(&tmp);
-
return ret;
-
}
-
-
/*
-
* define a new function
-
* if func isn't given, it is supposed to be a prototype.
-
*/
-
INT32 define_function(struct pike_string *name,
-
struct pike_type *type,
-
unsigned flags,
-
unsigned function_flags,
-
union idptr *func,
-
unsigned opt_flags)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct identifier *funp,fun;
-
struct reference ref;
-
struct svalue *lfun_type;
-
int run_time_type = T_FUNCTION;
-
INT32 i;
-
int getter_setter = -1;
-
int is_setter = 0;
-
-
CHECK_COMPILER();
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
{
-
struct pike_string *d = describe_type (type);
-
fprintf (stderr, "%.*sdefining function (pass=%d): %s ",
-
c->compilation_depth, "", Pike_compiler->compiler_pass, d->str);
-
free_string (d);
-
push_string (name);
-
print_svalue (stderr, --Pike_sp);
-
putc ('\n', stderr);
-
}
-
#endif
-
-
#ifdef PROFILING
-
fun.self_time=0;
-
fun.num_calls=0;
-
fun.recur_depth=0;
-
fun.total_time=0;
-
#endif
-
-
/* If this is an lfun, match against the predefined type. */
-
if ((lfun_type = low_mapping_string_lookup(lfun_types, name))) {
-
#ifdef PIKE_DEBUG
-
if (TYPEOF(*lfun_type) != T_TYPE) {
-
Pike_fatal("Bad entry in lfun_types for key \"%s\"\n", name->str);
-
}
-
#endif /* PIKE_DEBUG */
-
if (!pike_types_le(type, lfun_type->u.type)) {
-
int level = REPORT_NOTICE;
-
if (!match_types(type, lfun_type->u.type)) {
-
level = REPORT_ERROR;
-
} else if (c->lex.pragmas & ID_STRICT_TYPES) {
-
level = REPORT_WARNING;
-
}
-
if (level != REPORT_NOTICE) {
-
yytype_report(level, NULL, 0, lfun_type->u.type,
-
NULL, 0, type, 0,
-
"Type mismatch for callback function %S:", name);
-
}
-
}
-
} else if (((name->len > 3) &&
-
(index_shared_string(name, 0) == '`') &&
-
(index_shared_string(name, 1) == '-') &&
-
(index_shared_string(name, 2) == '>')) ||
-
((name->len > 1) &&
-
(index_shared_string(name, 0) == '`') &&
-
((index_shared_string(name, 1) >= 256) ||
-
isidchar(index_shared_string(name, 1))))) {
-
/* Getter setter. */
-
struct pike_string *symbol = NULL;
-
struct pike_type *symbol_type = NULL;
-
struct pike_type *gs_type = NULL;
-
int delta = 1; /* new-style */
-
if (index_shared_string(name, 1) == '-') {
-
/* Getter setter (old-style). */
-
delta = 3;
-
}
-
if (index_shared_string(name, name->len-1) != '=') {
-
/* fprintf(stderr, "Got getter: %s\n", name->str); */
-
gs_type = lfun_getter_type_string;
-
symbol = string_slice(name, delta, name->len-delta);
-
symbol_type = get_argument_type(type, -1);
-
} else if (name->len > delta+1) {
-
/* fprintf(stderr, "Got setter: %s\n", name->str); */
-
gs_type = lfun_setter_type_string;
-
is_setter = 1;
-
symbol = string_slice(name, delta, name->len-(delta+1));
-
symbol_type = get_argument_type(type, 0);
-
}
-
-
if (symbol) {
-
/* We got a getter or a setter. */
-
struct reference *ref;
-
if (!pike_types_le(type, gs_type)) {
-
int level = REPORT_NOTICE;
-
if (!match_types(type, gs_type)) {
-
level = REPORT_ERROR;
-
} else if (c->lex.pragmas & ID_STRICT_TYPES) {
-
level = REPORT_WARNING;
-
}
-
yytype_report(level, NULL, 0, gs_type,
-
NULL, 0, type, 0,
-
"Type mismatch for callback function %S:", name);
-
}
-
i = isidentifier(symbol);
-
if ((i >= 0) &&
-
!((ref = PTR_FROM_INT(Pike_compiler->new_program, i))->
-
id_flags & ID_INHERITED)) {
-
/* Not an inherited symbol. */
-
struct identifier *id = ID_FROM_INT(Pike_compiler->new_program, i);
-
if (!IDENTIFIER_IS_VARIABLE(id->identifier_flags)) {
-
my_yyerror("Illegal to redefine function %S with variable.", symbol);
-
} else if (id->run_time_type != PIKE_T_GET_SET) {
-
my_yyerror("Illegal to redefine a current variable with a getter/setter: %S.", symbol);
-
} else {
-
if ((ref->id_flags | ID_USED) != (flags | ID_USED)) {
-
if (Pike_compiler->compiler_pass == 1) {
-
yywarning("Modifier mismatch for variable %S.", symbol);
-
}
-
ref->id_flags &= flags | ID_USED;
-
}
-
getter_setter = i;
-
}
-
/* FIXME: Update id->type here. */
-
} else {
-
struct identifier *id;
-
i = low_define_variable(symbol, symbol_type, flags,
-
~0, PIKE_T_GET_SET);
-
id = ID_FROM_INT(Pike_compiler->new_program, i);
-
-
/* Paranoia. */
-
id->func.gs_info.getter = -1;
-
id->func.gs_info.setter = -1;
-
-
getter_setter = i;
-
}
-
/* NOTE: The function needs to have the same PRIVATE/INLINE
-
* behaviour as the variable for overloading to behave
-
* as expected.
-
*
-
* FIXME: Force PRIVATE?
-
*/
-
flags |= ID_PROTECTED /* | ID_PRIVATE | ID_INLINE | ID_USED */;
-
free_type(symbol_type);
-
free_string(symbol);
-
}
-
}
-
-
if(IDENTIFIER_IS_C_FUNCTION(function_flags))
-
Pike_compiler->new_program->flags |= PROGRAM_HAS_C_METHODS;
-
-
if (Pike_compiler->compiler_pass == 1) {
-
/* Mark the type as tentative by setting the runtime-type
-
* to T_MIXED.
-
*
-
* NOTE: This should be reset to T_FUNCTION in pass 2.
-
*/
-
run_time_type = T_MIXED;
-
}
-
-
i = isidentifier_variant(name, flags, type);
-
-
if(i >= 0)
-
{
-
int overridden;
-
-
/* already defined */
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
fprintf(stderr, "%.*sexisted as identifier #%d\n",
-
c->compilation_depth, "", i);
-
#endif
-
-
funp=ID_FROM_INT(Pike_compiler->new_program, i);
-
ref=Pike_compiler->new_program->identifier_references[i];
-
-
if (funp->identifier_flags & IDENTIFIER_HAS_BODY)
-
/* Keep this flag. */
-
function_flags |= IDENTIFIER_HAS_BODY;
-
-
if(!(ref.id_flags & ID_INHERITED)) /* not inherited */
-
{
-
-
if( !( IDENTIFIER_IS_FUNCTION(funp->identifier_flags) &&
-
( (!func || func->offset == -1) || (funp->func.offset == -1))))
-
{
-
my_yyerror("Identifier %S defined twice.", name);
-
-
if (getter_setter != -1) {
-
struct identifier *id = ID_FROM_INT(Pike_compiler->new_program,
-
getter_setter);
-
(&id->func.gs_info.getter)[is_setter] = i;
-
}
-
return i;
-
}
-
-
/* Note: The type from pass 1 may be incompatible with the one from
-
* pass 2. Only do this in pass 2, and only if the previous
-
* type isn't from pass 1.
-
*/
-
if ((Pike_compiler->compiler_pass == 2) &&
-
(funp->run_time_type == T_FUNCTION)) {
-
/* match types against earlier prototype or vice versa */
-
if(!match_types(type, funp->type))
-
{
-
yytype_report(REPORT_ERROR, NULL, 0,
-
funp->type,
-
NULL, 0, type, 0,
-
"Prototype doesn't match for function %S.", name);
-
}
-
}
-
-
if(func)
-
funp->func = *func;
-
#if 0 /* prototypes does not override non-prototypes, ok? */
-
else
-
funp->func.offset = -1;
-
#endif
-
-
funp->identifier_flags=function_flags;
-
funp->run_time_type = run_time_type;
-
-
funp->opt_flags &= opt_flags;
-
-
free_type(funp->type);
-
copy_pike_type(funp->type, type);
-
}else{
-
#ifdef PROGRAM_BUILD_DEBUG
-
fprintf(stderr, "%.*sidentifier was inherited\n",
-
c->compilation_depth, "");
-
#endif
-
-
if((ref.id_flags & ID_FINAL)
-
#if 0
-
&& !(funp->func.offset == -1)
-
#endif
-
)
-
{
-
my_yyerror("Illegal to redefine 'final' function %S.", name);
-
}
-
-
-
if(ref.id_flags & ID_INLINE)
-
{
-
#ifdef PROGRAM_BUILD_DEBUG
-
fprintf(stderr, "%.*sidentifier is local\n",
-
c->compilation_depth, "");
-
#endif
-
/* Hide the previous definition, and make a new definition. */
-
Pike_compiler->new_program->identifier_references[i].id_flags |=
-
ID_PROTECTED;
-
goto make_a_new_def;
-
}
-
-
/* Otherwise we alter the existing definition */
-
#ifdef PROGRAM_BUILD_DEBUG
-
fprintf(stderr, "%.*saltering the existing definition\n",
-
c->compilation_depth, "");
-
#endif
-
-
copy_shared_string(fun.name, name);
-
copy_pike_type(fun.type, type);
-
fun.filename_strno = store_prog_string(c->lex.current_file);
-
fun.linenumber = c->lex.current_line;
-
-
fun.run_time_type = run_time_type;
-
-
fun.identifier_flags=function_flags;
-
-
if(func)
-
fun.func = *func;
-
else
-
fun.func.offset = -1;
-
-
fun.opt_flags = opt_flags;
-
-
ref.identifier_offset=Pike_compiler->new_program->num_identifiers;
-
debug_add_to_identifiers(fun);
-
}
-
-
if (flags & ID_PRIVATE) flags |= ID_LOCAL|ID_PROTECTED;
-
-
ref.inherit_offset = 0;
-
ref.id_flags = flags;
-
if (flags & ID_VARIANT) {
-
ref.id_flags |= ID_USED;
-
Pike_compiler->new_program->identifier_references[i] = ref;
-
overridden = i;
-
} else {
-
overridden = override_identifier(&ref, name);
-
}
-
if (overridden >= 0) {
-
#ifdef PIKE_DEBUG
-
struct reference *oref =
-
Pike_compiler->new_program->identifier_references+overridden;
-
if((oref->inherit_offset != ref.inherit_offset) ||
-
(oref->identifier_offset != ref.identifier_offset) ||
-
((oref->id_flags | ID_USED) != (ref.id_flags | ID_USED))) {
-
fprintf(stderr,
-
"ref: %d:%d 0x%04x\n"
-
"got: %d:%d 0x%04x (%d)\n",
-
ref.inherit_offset, ref.identifier_offset,
-
ref.id_flags,
-
oref->inherit_offset,
-
oref->identifier_offset,
-
oref->id_flags,
-
overridden);
-
Pike_fatal("New function overloading algorithm failed!\n");
-
}
-
#endif
-
-
if (getter_setter != -1) {
-
struct identifier *id = ID_FROM_INT(Pike_compiler->new_program,
-
getter_setter);
-
INT32 old_i = (&id->func.gs_info.getter)[is_setter];
-
if ((old_i >= 0) && (old_i != overridden)) {
-
my_yyerror("Multiple definitions for %S.", name);
-
}
-
(&id->func.gs_info.getter)[is_setter] = overridden;
-
}
-
return overridden;
-
}
-
/* NOTE: At this point we already have the identifier in the
-
* new program, and just need to add the reference.
-
*/
-
} else {
-
make_a_new_def:
-
-
#ifdef PIKE_DEBUG
-
if(Pike_compiler->compiler_pass==2)
-
Pike_fatal("Internal error: Not allowed to add more identifiers during second compiler pass.\n");
-
#endif
-
-
/* Define a new function */
-
-
copy_shared_string(fun.name, name);
-
copy_pike_type(fun.type, type);
-
fun.filename_strno = store_prog_string(c->lex.current_file);
-
fun.linenumber = c->lex.current_line;
-
-
fun.identifier_flags=function_flags;
-
fun.run_time_type = run_time_type;
-
-
if(func)
-
fun.func = *func;
-
else
-
fun.func.offset = -1;
-
-
fun.opt_flags = opt_flags;
-
-
#ifdef PIKE_DEBUG
-
if (a_flag > 5) {
-
fprintf(stderr,
-
"Adding new function #%d: '%s'\n"
-
" identifier_flags:0x%02x opt_flags:0x%04x\n",
-
Pike_compiler->new_program->num_identifiers,
-
fun.name->str,
-
fun.identifier_flags, fun.opt_flags);
-
}
-
#endif /* PIKE_DEBUG */
-
-
i=Pike_compiler->new_program->num_identifiers;
-
-
debug_add_to_identifiers(fun);
-
-
if (flags & ID_PRIVATE) flags |= ID_LOCAL|ID_PROTECTED;
-
-
ref.id_flags = flags;
-
ref.identifier_offset = i;
-
ref.inherit_offset = 0;
-
}
-
-
ref.run_time_type = PIKE_T_UNKNOWN;
-
-
/* Add the reference. */
-
-
i=Pike_compiler->new_program->num_identifier_references;
-
add_to_identifier_references(ref);
-
-
#ifdef PROGRAM_BUILD_DEBUG
-
fprintf(stderr, "%.*sadded new definition #%d\n",
-
c->compilation_depth, "", i);
-
#endif
-
-
if (getter_setter != -1) {
-
struct identifier *id = ID_FROM_INT(Pike_compiler->new_program,
-
getter_setter);
-
INT32 old_i = (&id->func.gs_info.getter)[is_setter];
-
if (old_i >= 0) {
-
my_yyerror("Multiple definitions for %S.", name);
-
}
-
(&id->func.gs_info.getter)[is_setter] = i;
-
}
-
-
return i;
-
}
-
-
#if 0
-
-
int add_ext_ref(struct program_state *state, struct program *target, int i)
-
{
-
struct reference ref, *r;
-
int j;
-
if (state->new_program == target) return i;
-
i = add_ext_ref(state->previous, target, i);
-
for (r = state->new_program->identifier_references, j = 0;
-
j < state->new_program->num_identifier_references;
-
j++, r++) {
-
if (((r->id_flags & (ID_PARENT_REF|ID_PROTECTED|ID_PRIVATE|ID_HIDDEN)) ==
-
ID_PARENT_REF|ID_PROTECTED|ID_PRIVATE|ID_HIDDEN) &&
-
(r->identifier_offset == i) &&
-
(!(r->inherit_offset))) {
-
return j;
-
}
-
}
-
ref.id_flags = ID_PARENT_REF|ID_PROTECTED|ID_PRIVATE|ID_HIDDEN|ID_INLINE;
-
ref.identifier_offset = i;
-
ref.inherit_offset = 0;
-
ref.run_time_type = PIKE_T_UNKNOWN;
-
add_to_identifier_references(ref);
-
state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT;
-
return j;
-
}
-
-
#endif /* 0 */
-
-
/* Identifier lookup
-
*
-
* The search algorithm has changed several times during Pike 7.3.
-
*
-
* It now (Pike 7.3.33 and later) looks up the most recent definition
-
* in the most recent inherit.
-
*
-
* In Pike 7.3.23 -- 7.3.32 it looked up the most recent definition
-
* with the least inherit depth.
-
*
-
* In Pike 7.3.22 and prior, it looked up the last definition regardless
-
* of inherit depth, unless there was a definition in the current program.
-
*
-
* Note also that the changed handling of mixin's in Pike 7.7.40 affects
-
* the behaviour when using static inherit. See F below.
-
*
-
* Example:
-
*
-
* class A {
-
* int foo() {}
-
* }
-
*
-
* class B {
-
* int foo() {}
-
* inherit A;
-
* }
-
*
-
* class C {
-
* inherit B;
-
* }
-
*
-
* class D {
-
* inherit B;
-
* inherit C;
-
* }
-
*
-
* class E {
-
* int foo() {}
-
* }
-
*
-
* class F {
-
* inherit A;
-
* static inherit E;
-
* }
-
*
-
* Lookup of identifier "foo" in D():
-
*
-
* D-+-B-+-foo Pike 7.3.23 --- Pike 7.3.32
-
* | |
-
* | +-A---foo
-
* |
-
* +-C---B-+-foo Pike 7.3.33 ---
-
* |
-
* +-A---foo --- Pike 7.3.22
-
*
-
* Lookup of identifier "foo" in C():
-
*
-
* C---B-+-foo Pike 7.3.23 ---
-
* |
-
* +-A---foo --- Pike 7.3.22
-
*
-
* Lookup of identifier "foo" in B():
-
*
-
* B-+-foo All versions of Pike
-
* |
-
* +-A---foo
-
*
-
* External lookup of identifier "foo" in E():
-
*
-
* F-+-A---foo --- Pike 7.7.33
-
* |
-
* +-E---foo Pike 7.7.34 ---
-
*/
-
int really_low_find_shared_string_identifier(struct pike_string *name,
-
struct program *prog,
-
int flags)
-
{
-
struct reference *funp;
-
struct identifier *fun;
-
int id, i, depth, last_inh;
-
-
#if 0
-
CDFPRINTF((stderr,"th(%ld) %p Trying to find %s flags=%d\n",
-
(long)th_self(), prog, name->str, flags));
-
#endif
-
-
#ifdef PIKE_DEBUG
-
if (!prog) {
-
Pike_fatal("really_low_find_shared_string_identifier(\"%s\", NULL, %d)\n"
-
"prog is NULL!\n", name->str, flags);
-
}
-
#endif /* PIKE_DEBUG */
-
-
id = -1;
-
depth = 0;
-
last_inh = prog->num_inherits;
-
i = (int)prog->num_identifier_references;
-
while(i--)
-
{
-
funp = prog->identifier_references + i;
-
if(funp->id_flags & ID_HIDDEN) continue;
-
if(funp->id_flags & ID_VARIANT) continue;
-
if(funp->id_flags & ID_PROTECTED)
-
if(!(flags & SEE_PROTECTED))
-
continue;
-
fun = ID_FROM_PTR(prog, funp);
-
/* if(fun->func.offset == -1) continue; * Prototype */
-
if(!is_same_string(fun->name,name)) continue;
-
if(funp->id_flags & ID_INHERITED)
-
{
-
struct inherit *inh = INHERIT_FROM_PTR(prog, funp);
-
if ((funp->id_flags & ID_PRIVATE) && !(flags & SEE_PRIVATE)) continue;
-
if (!depth || (depth > inh->inherit_level)) {
-
if (id != -1) {
-
int j;
-
int min_level = depth;
-
for (j=last_inh-1; j > funp->inherit_offset; j--) {
-
struct inherit *inh2 = prog->inherits + j;
-
if (inh2->inherit_level >= min_level) {
-
/* Got deeper in the inherit graph */
-
continue;
-
}
-
min_level = inh2->inherit_level;
-
}
-
if (!(inh->inherit_level < min_level)) {
-
continue;
-
}
-
/* Found new identifier on the path from the old identifier to
-
* the root.
-
*/
-
}
-
last_inh = funp->inherit_offset;
-
depth = inh->inherit_level;
-
id = i;
-
}
-
} else {
-
return i;
-
}
-
}
-
return id;
-
}
-
-
int really_low_find_variant_identifier(struct pike_string *name,
-
struct program *prog,
-
struct pike_type *type,
-
int start_pos,
-
int flags)
-
{
-
struct reference *funp;
-
struct identifier *fun;
-
int id, i, depth, last_inh;
-
-
#if 1
-
#ifdef COMPILER_DEBUG
-
fprintf(stderr,"th(%ld) %p Trying to find variant \"%s\" start=%d flags=%d\n"
-
" type: ",
-
(long)th_self(), prog, name->str, start_pos, flags);
-
simple_describe_type(type);
-
fprintf(stderr, "\n");
-
#endif
-
#endif
-
-
#ifdef PIKE_DEBUG
-
if (!prog) {
-
Pike_fatal("really_low_find_variant_identifier(\"%s\", NULL, %p, %d, %d)\n"
-
"prog is NULL!\n", name->str, type, start_pos, flags);
-
}
-
#endif /* PIKE_DEBUG */
-
-
id = -1;
-
depth = 0;
-
last_inh = prog->num_inherits;
-
i = start_pos;
-
#ifdef PIKE_DEBUG
-
if (i > (int)prog->num_identifier_references) {
-
Pike_fatal("really_low_find_variant_identifier(\"%s\", %p, %p, %d, %d):\n"
-
"Start position is past max: %d\n",
-
name->str, prog, type, start_pos, flags,
-
prog->num_identifier_references);
-
}
-
#endif /* PIKE_DEBUG */
-
while(i--)
-
{
-
funp = prog->identifier_references + i;
-
if(funp->id_flags & ID_HIDDEN) continue;
-
if(!(funp->id_flags & ID_VARIANT)) continue;
-
if(funp->id_flags & ID_PROTECTED)
-
if(!(flags & SEE_PROTECTED))
-
continue;
-
fun = ID_FROM_PTR(prog, funp);
-
/* if(fun->func.offset == -1) continue; * Prototype */
-
if(!is_same_string(fun->name,name)) continue;
-
if(type && (fun->type != type)) continue;
-
if(funp->id_flags & ID_INHERITED)
-
{
-
struct inherit *inh = INHERIT_FROM_PTR(prog, funp);
-
if ((funp->id_flags & ID_PRIVATE) && !(flags & SEE_PRIVATE)) continue;
-
if (!depth || (depth > inh->inherit_level)) {
-
if (id != -1) {
-
int j;
-
int min_level = depth;
-
for (j=last_inh-1; j > funp->inherit_offset; j--) {
-
struct inherit *inh2 = prog->inherits + j;
-
if (inh2->inherit_level >= min_level) {
-
/* Got deeper in the inherit graph */
-
continue;
-
}
-
min_level = inh2->inherit_level;
-
}
-
if (!(inh->inherit_level < min_level)) {
-
continue;
-
}
-
/* Found new identifier on the path from the old identifier to
-
* the root.
-
*/
-
}
-
last_inh = funp->inherit_offset;
-
depth = inh->inherit_level;
-
id = i;
-
}
-
} else {
-
CDFPRINTF((stderr, "Found %d\n", i));
-
return i;
-
}
-
}
-
CDFPRINTF((stderr, "Found %d\n", id));
-
return id;
-
}
-
-
/**
-
* This is the dispatcher function for variant functions.
-
*
-
* cf end_first_pass().
-
*/
-
static void f_dispatch_variant(INT32 args)
-
{
-
struct pike_frame *fp = Pike_fp;
-
int fun_num = fp->fun;
-
struct program *prog = fp->context->prog;
-
struct identifier *id = ID_FROM_INT(prog, fun_num);
-
struct pike_string *name = id->name;
-
while (fun_num--) {
-
int i;
-
struct pike_type *t;
-
struct pike_type *ret;
-
-
if (!(prog->identifier_references[fun_num].id_flags & ID_VARIANT)) {
-
continue;
-
}
-
id = ID_FROM_INT(prog, fun_num);
-
if (id->name != name) continue;
-
-
add_ref(t = id->type);
-
-
/* Check whether the type is compatible with our arguments. */
-
for (i = 0; i < args; i++) {
-
struct pike_type *cont = check_call_svalue(t, 0, Pike_sp+i - args);
-
free_type(t);
-
if (!(t = cont)) break;
-
}
-
if (!t) continue;
-
ret = new_get_return_type(t, 0);
-
free_type(t);
-
if (!ret) continue;
-
free_type(ret);
-
-
/* Found a function to call! */
-
apply_current(fun_num, args);
-
return;
-
}
-
Pike_error("Invalid arguments to %S()!\n", name);
-
}
-
-
PMOD_EXPORT int low_find_lfun(struct program *p, ptrdiff_t lfun)
-
{
-
struct pike_string *lfun_name = lfun_strings[lfun];
-
unsigned int flags = 0;
-
#if 0
-
struct identifier *id;
-
#endif
-
int i =
-
really_low_find_shared_string_identifier(lfun_name,
-
dmalloc_touch(struct program *,
-
p),
-
SEE_PROTECTED);
-
#if 0
-
if (i < 0 || !(p->flags & PROGRAM_FIXED)) return i;
-
id = ID_FROM_INT(p, i);
-
if (IDENTIFIER_IS_PIKE_FUNCTION(id->identifier_flags) &&
-
(id->func.offset == -1)) {
-
/* Function prototype. */
-
return -1;
-
}
-
#endif /* 0 */
-
return i;
-
}
-
-
int lfun_lookup_id(struct pike_string *lfun_name)
-
{
-
struct svalue *id = low_mapping_string_lookup(lfun_ids, lfun_name);
-
if (!id) return -1;
-
if (TYPEOF(*id) == T_INT) return id->u.integer;
-
my_yyerror("Bad entry in lfun lookup table for %S.", lfun_name);
-
return -1;
-
}
-
-
/*
-
* lookup the number of a function in a program given the name in
-
* a shared_string
-
*/
-
int low_find_shared_string_identifier(struct pike_string *name,
-
struct program *prog)
-
{
-
int max,min,tst;
-
struct identifier *fun;
-
-
if(prog->flags & PROGRAM_FIXED)
-
{
-
unsigned short *funindex = prog->identifier_index;
-
size_t val_n = PTR_TO_INT (name);
-
-
#ifdef PIKE_DEBUG
-
if(!funindex)
-
Pike_fatal("No funindex in fixed program\n");
-
#endif
-
-
max = prog->num_identifier_index;
-
min = 0;
-
while(max != min)
-
{
-
size_t val_t;
-
-
tst=(max + min) >> 1;
-
fun = ID_FROM_INT(prog, funindex[tst]);
-
if(is_same_string(fun->name,name)) return funindex[tst];
-
val_t = PTR_TO_INT (fun->name);
-
if (val_n < val_t) {
-
max = tst;
-
} else {
-
min = tst+1;
-
}
-
}
-
}else{
-
return really_low_find_shared_string_identifier(name,prog,0);
-
}
-
return -1;
-
}
-
-
#ifdef FIND_FUNCTION_HASHSIZE
-
#if FIND_FUNCTION_HASHSIZE == 0
-
#undef FIND_FUNCTION_HASHSIZE
-
#endif
-
#endif
-
-
#ifdef FIND_FUNCTION_HASHSIZE
-
struct ff_hash
-
{
-
struct pike_string *name;
-
int id;
-
int fun;
-
};
-
-
static struct ff_hash cache[FIND_FUNCTION_HASHSIZE];
-
#endif
-
-
int find_shared_string_identifier(struct pike_string *name,
-
struct program *prog)
-
{
-
#ifdef PIKE_DEBUG
-
if (!prog) {
-
Pike_fatal("find_shared_string_identifier(): No program!\n"
-
"Identifier: %s%s%s\n",
-
name?"\"":"", name?name->str:"NULL", name?"\"":"");
-
}
-
#endif /* PIKE_DEBUG */
-
#ifdef FIND_FUNCTION_HASHSIZE
-
if(prog -> flags & PROGRAM_FIXED
-
#if FIND_FUNCTION_HASH_TRESHOLD - 0
-
&& prog->num_identifier_index >= FIND_FUNCTION_HASH_TRESHOLD
-
#endif
-
)
-
{
-
size_t hashval;
-
hashval = my_hash_string(name);
-
hashval += prog->id;
-
hashval &= (FIND_FUNCTION_HASHSIZE-1);
-
if(is_same_string(cache[hashval].name,name) &&
-
cache[hashval].id==prog->id)
-
return cache[hashval].fun;
-
-
if(cache[hashval].name) free_string(cache[hashval].name);
-
copy_shared_string(cache[hashval].name,name);
-
cache[hashval].id=prog->id;
-
return cache[hashval].fun=low_find_shared_string_identifier(name,prog);
-
}
-
#endif /* FIND_FUNCTION_HASHSIZE */
-
-
return low_find_shared_string_identifier(name,prog);
-
}
-
-
PMOD_EXPORT int find_identifier(const char *name,struct program *prog)
-
{
-
struct pike_string *n;
-
if(!prog) {
-
if (strlen(name) < 1024) {
-
Pike_error("Lookup of identifier %s in destructed object.\n", name);
-
} else {
-
Pike_error("Lookup of long identifier in destructed object.\n");
-
}
-
}
-
n=findstring(name);
-
if(!n) return -1;
-
return find_shared_string_identifier(n,prog);
-
}
-
-
int store_prog_string(struct pike_string *str)
-
{
-
unsigned int i;
-
-
for (i=0;i<Pike_compiler->new_program->num_strings;i++)
-
if (Pike_compiler->new_program->strings[i] == str)
-
return i;
-
-
reference_shared_string(str);
-
add_to_strings(str);
-
return i;
-
}
-
-
/* NOTE: O(n²)! */
-
int store_constant(const struct svalue *foo,
-
int equal,
-
struct pike_string *UNUSED(constant_name))
-
{
-
struct program_constant tmp;
-
volatile unsigned int e;
-
-
JMP_BUF jmp;
-
if (SETJMP(jmp)) {
-
handle_compile_exception ("Error comparing constants.");
-
/* Assume that if `==() throws an error, the svalues aren't equal. */
-
e = Pike_compiler->new_program->num_constants;
-
} else {
-
for(e=0;e<Pike_compiler->new_program->num_constants;e++)
-
{
-
struct program_constant *c = Pike_compiler->new_program->constants+e;
-
-
if (TYPEOF(*foo) == TYPEOF(c->sval)) {
-
/* Make sure only to compare within the same basic type. */
-
if (TYPEOF(*foo) == T_OBJECT) {
-
/* Special case objects -- We don't want strange LFUN effects... */
-
if ((foo->u.object == c->sval.u.object) &&
-
(SUBTYPEOF(*foo) == SUBTYPEOF(c->sval))) {
-
UNSETJMP(jmp);
-
return e;
-
}
-
} else if (TYPEOF(*foo) == T_INT) {
-
if (foo->u.integer == c->sval.u.integer) {
-
/* Make sure UNDEFINED is kept (but not in compat mode). */
-
if (foo->u.integer || (SUBTYPEOF(*foo) == SUBTYPEOF(c->sval)) ||
-
TEST_COMPAT(7, 6)) {
-
UNSETJMP(jmp);
-
return e;
-
}
-
}
-
} else if(equal ? is_equal(& c->sval,foo) : is_eq(& c->sval,foo)) {
-
UNSETJMP(jmp);
-
return e;
-
}
-
}
-
}
-
}
-
UNSETJMP(jmp);
-
assign_svalue_no_free(&tmp.sval,foo);
-
#if 0
-
if((tmp.name=constant_name)) add_ref(constant_name);
-
#else /* !0 */
-
tmp.offset = -1;
-
#endif /* 0 */
-
-
add_to_constants(tmp);
-
-
return e;
-
}
-
-
/*
-
* program examination functions available from Pike.
-
*/
-
-
struct array *program_indices(struct program *p)
-
{
-
int e;
-
int n = 0;
-
struct array *res;
-
for (e = p->num_identifier_references; e--; ) {
-
struct identifier *id;
-
if (p->identifier_references[e].id_flags &
-
(ID_HIDDEN|ID_VARIANT|ID_PROTECTED|ID_PRIVATE)) {
-
continue;
-
}
-
id = ID_FROM_INT(p, e);
-
if (IDENTIFIER_IS_ALIAS(id->identifier_flags)) {
-
/* FIXME!
-
*/
-
continue;
-
} else if (IDENTIFIER_IS_CONSTANT(id->identifier_flags)) {
-
if (id->func.const_info.offset >= 0) {
-
struct program *p2 = PROG_FROM_INT(p, e);
-
struct svalue *val = &p2->constants[id->func.const_info.offset].sval;
-
if ((TYPEOF(*val) != T_PROGRAM) ||
-
!(val->u.program->flags & PROGRAM_USES_PARENT)) {
-
ref_push_string(ID_FROM_INT(p, e)->name);
-
n++;
-
}
-
} else {
-
/* Prototype constant. */
-
ref_push_string(ID_FROM_INT(p, e)->name);
-
n++;
-
}
-
}
-
}
-
f_aggregate(n);
-
res = Pike_sp[-1].u.array;
-
add_ref(res);
-
pop_stack();
-
return(res);
-
}
-
-
struct array *program_values(struct program *p)
-
{
-
int e;
-
int n = 0;
-
struct array *res;
-
for(e = p->num_identifier_references; e--; ) {
-
struct identifier *id;
-
if (p->identifier_references[e].id_flags &
-
(ID_HIDDEN|ID_VARIANT|ID_PROTECTED|ID_PRIVATE)) {
-
continue;
-
}
-
id = ID_FROM_INT(p, e);
-
if (IDENTIFIER_IS_ALIAS(id->identifier_flags)) {
-
/* FIXME!
-
*/
-
continue;
-
} else if (IDENTIFIER_IS_CONSTANT(id->identifier_flags)) {
-
if (id->func.const_info.offset >= 0) {
-
struct program *p2 = PROG_FROM_INT(p, e);
-
struct svalue *val = &p2->constants[id->func.const_info.offset].sval;
-
if ((TYPEOF(*val) != T_PROGRAM) ||
-
!(val->u.program->flags & PROGRAM_USES_PARENT)) {
-
push_svalue(val);
-
n++;
-
}
-
} else {
-
/* Prototype constant. */
-
push_int(0);
-
n++;
-
}
-
}
-
}
-
f_aggregate(n);
-
res = Pike_sp[-1].u.array;
-
add_ref(res);
-
pop_stack();
-
return(res);
-
}
-
-
struct array *program_types(struct program *p)
-
{
-
int e;
-
int n = 0;
-
struct array *res;
-
for (e = p->num_identifier_references; e--; ) {
-
struct identifier *id;
-
if (p->identifier_references[e].id_flags &
-
(ID_HIDDEN|ID_VARIANT|ID_PROTECTED|ID_PRIVATE)) {
-
continue;
-
}
-
id = ID_FROM_INT(p, e);
-
if (IDENTIFIER_IS_ALIAS(id->identifier_flags)) {
-
/* FIXME!
-
*/
-
continue;
-
} else if (IDENTIFIER_IS_CONSTANT(id->identifier_flags)) {
-
if (id->func.const_info.offset >= 0) {
-
struct program *p2 = PROG_FROM_INT(p, e);
-
struct svalue *val = &p2->constants[id->func.const_info.offset].sval;
-
if ((TYPEOF(*val) != T_PROGRAM) ||
-
!(val->u.program->flags & PROGRAM_USES_PARENT)) {
-
ref_push_type_value(ID_FROM_INT(p, e)->type);
-
n++;
-
}
-
} else {
-
/* Prototype constant. */
-
ref_push_type_value(ID_FROM_INT(p, e)->type);
-
n++;
-
}
-
}
-
}
-
f_aggregate(n);
-
res = Pike_sp[-1].u.array;
-
add_ref(res);
-
pop_stack();
-
return(res);
-
}
-
-
int low_program_index_no_free(struct svalue *to, struct program *p, int e,
-
struct object *parent, int parent_identifier)
-
{
-
struct identifier *id;
-
id=ID_FROM_INT(p, e);
-
-
if (IDENTIFIER_IS_ALIAS(id->identifier_flags)) {
-
struct external_variable_context loc;
-
struct object fake_object;
-
struct parent_info parent_info;
-
int refid;
-
-
if (!parent) return 0;
-
-
parent_info.parent = parent;
-
parent_info.parent_identifier = parent_identifier;
-
fake_object.prog = p;
-
fake_object.refs = 1;
-
fake_object.next = fake_object.prev = NULL;
-
fake_object.storage = ((char *)&parent_info) - p->parent_info_storage;
-
#ifdef PIKE_DEBUG
-
fake_object.program_id = p->id;
-
#endif
-
-
loc.o = &fake_object;
-
loc.inherit = INHERIT_FROM_INT(p, e);
-
loc.parent_identifier = 0;
-
-
do {
-
find_external_context(&loc, id->func.ext_ref.depth);
-
refid = id->func.ext_ref.id;
-
id = ID_FROM_INT(loc.o->prog, refid);
-
} while (IDENTIFIER_IS_ALIAS(id->identifier_flags));
-
-
if (fake_object.refs != 1) {
-
Pike_fatal("Lost track of fake object! refs: %d\n",
-
fake_object.refs);
-
}
-
-
if (loc.o != &fake_object) {
-
low_object_index_no_free(to, loc.o, refid);
-
#if 0 && defined (COMPILER_DEBUG)
-
safe_pike_fprintf (stderr, "low_program_index_no_free1 %O->%S: %O\n",
-
what, s, to);
-
#endif
-
return 1;
-
}
-
}
-
-
if (IDENTIFIER_IS_CONSTANT(id->identifier_flags)) {
-
if (id->func.const_info.offset >= 0) {
-
struct program *p2 = PROG_FROM_INT(p, e);
-
struct svalue *val = &p2->constants[id->func.const_info.offset].sval;
-
assign_svalue_no_free(to, val);
-
} else {
-
/* Prototype constant. */
-
SET_SVAL(*to, T_INT, NUMBER_NUMBER, integer, 0);
-
}
-
#if 0 && defined (COMPILER_DEBUG)
-
safe_pike_fprintf (stderr, "low_program_index_no_free2 %O->%S: %O\n",
-
what, s, to);
-
#endif
-
return 1;
-
}
-
return 0;
-
}
-
-
int program_index_no_free(struct svalue *to, struct svalue *what,
-
struct svalue *ind)
-
{
-
int e;
-
struct pike_string *s;
-
struct object *parent = NULL;
-
struct svalue *sub = NULL;
-
struct program *p;
-
struct identifier *id;
-
int parent_identifier = -1;
-
-
if (TYPEOF(*what) == T_PROGRAM) {
-
p = what->u.program;
-
} else if ((TYPEOF(*what) == T_FUNCTION) &&
-
(SUBTYPEOF(*what) != FUNCTION_BUILTIN) &&
-
((parent = what->u.object)->prog) &&
-
IDENTIFIER_IS_CONSTANT((id = ID_FROM_INT(parent->prog,
-
SUBTYPEOF(*what)))->identifier_flags) &&
-
(id->func.const_info.offset != -1) &&
-
(TYPEOF(*(sub = &PROG_FROM_INT(parent->prog, SUBTYPEOF(*what))->
-
constants[id->func.const_info.offset].sval)) == T_PROGRAM)) {
-
p = sub->u.program;
-
parent_identifier = SUBTYPEOF(*what);
-
} else {
-
/* Not a program. */
-
return 0;
-
}
-
if (TYPEOF(*ind) != T_STRING) {
-
Pike_error("Can't index a program with a %s (expected string)\n",
-
get_name_of_type(TYPEOF(*ind)));
-
}
-
s = ind->u.string;
-
e=find_shared_string_identifier(s, p);
-
if(e!=-1)
-
{
-
if (low_program_index_no_free(to, p, e, parent, parent_identifier))
-
return 1;
-
}
-
-
SET_SVAL(*to, T_INT, NUMBER_UNDEFINED, integer, 0);
-
return 1;
-
}
-
-
/*
-
* Line number support routines, now also tells what file we are in.
-
*
-
* FIXME: Consider storing the filenames in strings (like what is now done
-
* for identifiers).
-
*/
-
-
/* program.linenumbers format:
-
*
-
* Filename entry:
-
* 1. char 127 (marker).
-
* 2. small number Filename string length.
-
* 3. char Filename string size shift.
-
* 4. string data (Possibly wide) filename string without null
-
* termination.
-
* Each character is stored in native byte order.
-
*
-
* Line number entry:
-
* 1. small number Index in program.program (pc).
-
* Stored as the difference from the pc in the
-
* closest previous line number entry. The first
-
* stored entry is absolute.
-
* 2. small number Line number. Stored in the same way as the pc.
-
*
-
* Small number:
-
* If -127 < n < 127:
-
* 1. char The number.
-
* Else if -32768 <= n < 32768:
-
* 1. char -127 (marker).
-
* 2. short The 16-bit signed number stored in big endian order.
-
* Else if n < -0x80000000 or n > 0x7fffffff:
-
* 1. char -127 (marker).
-
* 2. short Zero (64-bit marker).
-
* 3. INT_TYPE The 64-bit signed number stored in big endian order.
-
* Else:
-
* 1. char -128 (marker).
-
* 2. int The 32-bit signed number stored in big endian order.
-
*
-
* Whenever the filename changes, a filename entry followed by a line
-
* number entry is stored. If only the line number changes, a line
-
* number entry is stored. The first stored entry (at pc 0) is the
-
* file and line where the program is defined, if they are known. The
-
* definition line for a top level program is set to 0.
-
*/
-
-
INT_TYPE get_small_number(char **q)
-
{
-
/* This is a workaround for buggy cc & Tru64 */
-
unsigned char *addr = (unsigned char *)*q;
-
INT_TYPE ret = *((signed char *)addr);
-
ret=*(signed char *)*q;
-
addr++;
-
switch(ret)
-
{
-
case -127:
-
ret = (((signed char *)addr)[0]<<8) | addr[1];
-
addr += 2;
-
if (!ret) {
-
/* 64-bit signed number. */
-
ret = *((signed char *)addr++);
-
ret = (ret<<8) | *(addr++);
-
ret = (ret<<8) | *(addr++);
-
ret = (ret<<8) | *(addr++);
-
ret = (ret<<8) | *(addr++);
-
ret = (ret<<8) | *(addr++);
-
ret = (ret<<8) | *(addr++);
-
ret = (ret<<8) | *(addr++);
-
}
-
break;
-
-
case -128:
-
ret = (((signed char *)addr)[0]<<24) | (addr[1]<<16) |
-
(addr[2]<<8) | addr[3];
-
addr += 4;
-
break;
-
-
#ifdef PIKE_DEBUG
-
case 127:
-
Pike_fatal("get_small_number used on filename entry\n");
-
#endif
-
}
-
*q = (char *)addr;
-
return ret;
-
}
-
-
void start_line_numbering(void)
-
{
-
if(Pike_compiler->last_file)
-
{
-
free_string(Pike_compiler->last_file);
-
Pike_compiler->last_file=0;
-
}
-
Pike_compiler->last_pc=Pike_compiler->last_line=0;
-
}
-
-
static void insert_small_number(INT_TYPE a)
-
{
-
#ifdef PIKE_DEBUG
-
size_t start = Pike_compiler->new_program->num_linenumbers;
-
#endif /* PIKE_DEBUG */
-
if(a>-127 && a<127)
-
{
-
add_to_linenumbers(a);
-
}else if(a>=-32768 && a<32768){
-
add_to_linenumbers(-127);
-
add_to_linenumbers(a>>8);
-
add_to_linenumbers(a);
-
#ifdef INT_TYPE_INT32_CONVERSION
-
} else if (a < -0x80000000L || a > 0x7fffffffL) {
-
/* Overload 16-bit zero as marker for 64-bit. */
-
fprintf(stderr, "Saving huge linenumber: %lld\n", (long long)a);
-
add_to_linenumbers(-127);
-
add_to_linenumbers(0);
-
add_to_linenumbers(0);
-
add_to_linenumbers(a>>56);
-
add_to_linenumbers(a>>48);
-
add_to_linenumbers(a>>40);
-
add_to_linenumbers(a>>32);
-
add_to_linenumbers(a>>24);
-
add_to_linenumbers(a>>16);
-
add_to_linenumbers(a>>8);
-
add_to_linenumbers(a);
-
#endif
-
}else{
-
add_to_linenumbers(-128);
-
add_to_linenumbers(a>>24);
-
add_to_linenumbers(a>>16);
-
add_to_linenumbers(a>>8);
-
add_to_linenumbers(a);
-
}
-
#ifdef PIKE_DEBUG
-
{
-
char *tmp = Pike_compiler->new_program->linenumbers + start;
-
INT_TYPE res = get_small_number(&tmp);
-
if (a != res) {
-
tmp = Pike_compiler->new_program->linenumbers + start;
-
fprintf(stderr, "0x%p: %02x %02x %02x %02x %02x\n",
-
tmp, (unsigned char) tmp[0], (unsigned char) tmp[1],
-
(unsigned char) tmp[2], (unsigned char) tmp[3], (unsigned char) tmp[4]);
-
if ((start + 5) < Pike_compiler->new_program->num_linenumbers) {
-
/* 64-bit. Dump the remaining 6 bytes as well. */
-
fprintf(stderr, "0x%p: %02x %02x %02x %02x %02x %02x\n",
-
tmp, (unsigned char) tmp[5], (unsigned char) tmp[6],
-
(unsigned char) tmp[7], (unsigned char) tmp[8],
-
(unsigned char) tmp[9], (unsigned char) tmp[10]);
-
}
-
Pike_fatal("insert_small_number failed: %ld (0x%08lx) != %ld (0x%08lx)\n",
-
(long)a, (long)a, (long)res, (long)res);
-
}
-
}
-
#endif /* PIKE_DEBUG */
-
}
-
-
static void ext_insert_small_number (char **ptr, INT_TYPE a)
-
{
-
if(a>-127 && a<127)
-
{
-
*(*ptr)++ = a;
-
}else if(a>=-32768 && a<32768){
-
*(*ptr)++ = -127;
-
*(*ptr)++ = a>>8;
-
*(*ptr)++ = a;
-
#ifdef INT_TYPE_INT32_CONVERSION
-
} else if (a < -0x80000000L || a > 0x7fffffffL) {
-
/* Overload 16-bit zero as marker for 64-bit. */
-
*(*ptr)++ = -127;
-
*(*ptr)++ = 0;
-
*(*ptr)++ = 0;
-
*(*ptr)++ = a>>56;
-
*(*ptr)++ = a>>48;
-
*(*ptr)++ = a>>40;
-
*(*ptr)++ = a>>32;
-
*(*ptr)++ = a>>24;
-
*(*ptr)++ = a>>16;
-
*(*ptr)++ = a>>8;
-
*(*ptr)++ = a;
-
#endif
-
}else{
-
*(*ptr)++ = -128;
-
*(*ptr)++ = a>>24;
-
*(*ptr)++ = a>>16;
-
*(*ptr)++ = a>>8;
-
*(*ptr)++ = a;
-
}
-
}
-
-
void ext_store_program_line (struct program *prog, INT_TYPE line, struct pike_string *file)
-
{
-
char *ptr;
-
-
#ifdef PIKE_DEBUG
-
if (prog->linenumbers)
-
Pike_fatal ("Program already got linenumber info.\n");
-
if (Pike_compiler->new_program == prog)
-
Pike_fatal ("Use store_linenumber instead when the program is compiled.\n");
-
#endif
-
-
ptr = prog->linenumbers = xalloc (1 + 5 + 1 + (file->len << file->size_shift) + 1 + 11);
-
*ptr++ = 127; /* 1 */
-
ext_insert_small_number (&ptr, file->len); /* 5 */
-
*ptr++ = (char) file->size_shift; /* 1 */
-
MEMCPY (ptr, file->str, file->len << file->size_shift); /* - */
-
ptr += file->len << file->size_shift;
-
*ptr++ = 0; /* PC */ /* 1 */
-
ext_insert_small_number (&ptr, line); /* 11 */
-
prog->num_linenumbers = ptr - prog->linenumbers;
-
}
-
-
void store_linenumber(INT_TYPE current_line, struct pike_string *current_file)
-
{
-
/* if(!store_linenumbers) Pike_fatal("Fnord.\n"); */
-
#ifdef PIKE_DEBUG
-
if(a_flag)
-
{
-
INT_TYPE line=0;
-
INT32 off=0;
-
size_t len = 0;
-
INT32 shift = 0;
-
char *file=0;
-
char *cnt=Pike_compiler->new_program->linenumbers;
-
-
if (a_flag > 50) {
-
fprintf(stderr, "store_linenumber(%ld, \"%s\") at pc %d\n",
-
(long)current_line, current_file->str,
-
(INT32) PIKE_PC);
-
fprintf(stderr, " last_line:%ld last_file:\"%s\"\n",
-
(long)Pike_compiler->last_line,
-
Pike_compiler->last_file?Pike_compiler->last_file->str:"");
-
}
-
-
while(cnt < Pike_compiler->new_program->linenumbers +
-
Pike_compiler->new_program->num_linenumbers)
-
{
-
char *start = cnt;
-
if(*cnt == 127)
-
{
-
cnt++;
-
len = get_small_number(&cnt);
-
shift = *cnt;
-
file = ++cnt;
-
CHECK_FILE_ENTRY (Pike_compiler->new_program, cnt, len, shift);
-
cnt += len<<shift;
-
if (a_flag > 100) {
-
fprintf(stderr, "Filename entry:\n"
-
" len: %"PRINTSIZET"d, shift: %d\n",
-
len, shift);
-
}
-
}
-
off+=get_small_number(&cnt);
-
line+=get_small_number(&cnt);
-
if (a_flag > 100) {
-
fprintf(stderr, " off: %d, line: %ld\n"
-
" raw: ",
-
off, (long)line);
-
for (;start < cnt; start++) {
-
fprintf(stderr, "%02x ", *((unsigned char *)start));
-
}
-
fprintf(stderr, "\n");
-
}
-
}
-
-
if(Pike_compiler->last_line != line ||
-
Pike_compiler->last_pc != off ||
-
(Pike_compiler->last_file && file &&
-
MEMCMP(Pike_compiler->last_file->str, file, len<<shift)))
-
{
-
Pike_fatal("Line numbering out of whack\n"
-
" (line : %ld ?= %ld)!\n"
-
" ( pc : %d ?= %d)!\n"
-
" (shift: %d ?= %d)!\n"
-
" (len : %"PRINTSIZET"d ?= %"PRINTSIZET"d)!\n"
-
" (file : %s ?= %s)!\n",
-
(long)Pike_compiler->last_line, (long)line,
-
Pike_compiler->last_pc, off,
-
Pike_compiler->last_file?Pike_compiler->last_file->size_shift:0,
-
shift,
-
Pike_compiler->last_file?Pike_compiler->last_file->len:0, len,
-
Pike_compiler->last_file?Pike_compiler->last_file->str:"N/A",
-
file?file:"N/A");
-
}
-
}
-
#endif
-
if(Pike_compiler->last_line != current_line ||
-
Pike_compiler->last_file != current_file)
-
{
-
if(Pike_compiler->last_file != current_file)
-
{
-
char *tmp;
-
INT32 remain = DO_NOT_WARN((INT32)current_file->len)<<
-
current_file->size_shift;
-
-
if(Pike_compiler->last_file) free_string(Pike_compiler->last_file);
-
add_to_linenumbers(127);
-
insert_small_number(DO_NOT_WARN((INT32)current_file->len));
-
add_to_linenumbers(current_file->size_shift);
-
for(tmp=current_file->str; remain-- > 0; tmp++)
-
add_to_linenumbers(*tmp);
-
copy_shared_string(Pike_compiler->last_file, current_file);
-
}
-
insert_small_number(DO_NOT_WARN((INT32)(PIKE_PC-Pike_compiler->last_pc)));
-
insert_small_number(current_line-Pike_compiler->last_line);
-
Pike_compiler->last_line = current_line;
-
Pike_compiler->last_pc = DO_NOT_WARN((INT32)PIKE_PC);
-
}
-
}
-
-
#define FIND_PROGRAM_LINE(prog, file, len, shift, line) do { \
-
char *pos = prog->linenumbers; \
-
len = 0; \
-
shift = 0; \
-
file = NULL; \
-
\
-
if (pos < prog->linenumbers + prog->num_linenumbers) { \
-
if (*pos == 127) { \
-
pos++; \
-
len = get_small_number(&pos); \
-
shift = *pos; \
-
file = ++pos; \
-
CHECK_FILE_ENTRY (prog, pos, len, shift); \
-
pos += len<<shift; \
-
} \
-
get_small_number(&pos); /* Ignore the offset */ \
-
line = get_small_number(&pos); \
-
} \
-
} while (0)
-
-
PMOD_EXPORT struct pike_string *low_get_program_line (struct program *prog,
-
INT_TYPE *linep)
-
{
-
*linep = 0;
-
-
if (prog->linenumbers) {
-
size_t len;
-
INT32 shift;
-
char *file;
-
-
FIND_PROGRAM_LINE (prog, file, len, shift, (*linep));
-
-
if (file) {
-
struct pike_string *str = begin_wide_shared_string(len, shift);
-
memcpy(str->str, file, len<<shift);
-
return end_shared_string(str);
-
}
-
}
-
-
return NULL;
-
}
-
-
static char *make_plain_file (char *file, size_t len, INT32 shift, int malloced)
-
{
-
static char buf[1000];
-
if(shift)
-
{
-
size_t bufsize;
-
char *buffer;
-
PCHARP from=MKPCHARP(file, shift);
-
size_t ptr=0;
-
-
if (malloced) {
-
bufsize = len + 1;
-
buffer = malloc (bufsize);
-
}
-
else {
-
bufsize = NELEM(buf) - 1;
-
buffer = buf;
-
}
-
-
for (; len--; INC_PCHARP(from, 1))
-
{
-
size_t space;
-
int chr = EXTRACT_PCHARP(from);
-
space = chr > 255 ? 20 : 1;
-
-
if (ptr + space > bufsize) {
-
if (malloced) {
-
bufsize = (bufsize << 1) + space + 1;
-
buffer = realloc (buffer, bufsize);
-
}
-
else
-
break;
-
}
-
-
if(chr > 255)
-
{
-
sprintf(buffer+ptr,"\\u%04X",chr);
-
ptr+=strlen(buffer+ptr);
-
}else{
-
buffer[ptr++]=chr;
-
}
-
}
-
-
buffer[ptr]=0;
-
return buffer;
-
}
-
-
else{
-
char *buffer;
-
if (malloced)
-
buffer = malloc (len + 1);
-
else {
-
buffer = buf;
-
if (len > NELEM (buf) - 1)
-
len = NELEM (buf) - 1;
-
}
-
MEMCPY (buffer, file, len);
-
buffer[len] = 0;
-
return buffer;
-
}
-
}
-
-
/* Same as low_get_program_line but returns a plain char *. It's
-
* malloced if the malloced flag is set, otherwise it's a pointer to a
-
* static buffer which might be clobbered by later calls.
-
*
-
* This function is useful when the shared string table has been freed
-
* and in sensitive parts of the gc where the shared string structures
-
* can't be touched. It also converts wide strings to ordinary ones
-
* with escaping.
-
*/
-
PMOD_EXPORT char *low_get_program_line_plain(struct program *prog,
-
INT_TYPE *linep,
-
int malloced)
-
{
-
*linep = 0;
-
-
if (prog->linenumbers) {
-
char *file;
-
size_t len;
-
INT32 shift;
-
FIND_PROGRAM_LINE (prog, file, len, shift, (*linep));
-
if (file) return make_plain_file (file, len, shift, malloced);
-
}
-
-
return NULL;
-
}
-
-
/* Returns the file where the program is defined. The line of the
-
* class start is written to linep, or 0 if the program is the top
-
* level of the file. */
-
PMOD_EXPORT struct pike_string *get_program_line(struct program *prog,
-
INT_TYPE *linep)
-
{
-
struct pike_string *res = low_get_program_line(prog, linep);
-
if (!res) {
-
struct pike_string *dash;
-
REF_MAKE_CONST_STRING(dash, "-");
-
return dash;
-
}
-
return res;
-
}
-
-
PMOD_EXPORT struct pike_string *low_get_line (PIKE_OPCODE_T *pc,
-
struct program *prog,
-
INT_TYPE *linep)
-
{
-
linep[0] = 0;
-
-
if (prog->program && prog->linenumbers) {
-
ptrdiff_t offset = pc - prog->program;
-
if ((offset < (ptrdiff_t)prog->num_program) && (offset >= 0)) {
-
static char *file = NULL;
-
static char *base, *cnt;
-
static ptrdiff_t off;
-
static INT32 pid;
-
static INT_TYPE line;
-
static size_t len;
-
static INT32 shift;
-
-
if(prog->linenumbers == base && prog->id == pid && offset > off &&
-
cnt < prog->linenumbers + prog->num_linenumbers)
-
goto fromold;
-
-
base = cnt = prog->linenumbers;
-
off=line=0;
-
pid=prog->id;
-
file = 0;
-
-
while(cnt < prog->linenumbers + prog->num_linenumbers)
-
{
-
if(*cnt == 127)
-
{
-
cnt++;
-
len = get_small_number(&cnt);
-
shift = *cnt;
-
file = ++cnt;
-
CHECK_FILE_ENTRY (prog, cnt, len, shift);
-
cnt += len<<shift;
-
continue;
-
}
-
off+=get_small_number(&cnt);
-
fromold:
-
if(off > offset) break;
-
line+=get_small_number(&cnt);
-
}
-
if (cnt >= prog->linenumbers + prog->num_linenumbers) {
-
/* We reached the end of the table. Make sure
-
* we get in sync again next time we're called.
-
*/
-
base = NULL;
-
}
-
linep[0]=line;
-
if (file) {
-
struct pike_string *res = begin_wide_shared_string(len, shift);
-
memcpy(res->str, file, len<<shift);
-
return end_shared_string(res);
-
}
-
} else {
-
fprintf(stderr, "Bad offset: pc:%p program:%p (%p)\n",
-
pc, prog->program, (void *)prog->num_program);
-
}
-
} else {
-
fprintf(stderr, "No program of linenumbers program:%p linenumbers:%p\n",
-
prog->program, prog->linenumbers);
-
}
-
-
return NULL;
-
}
-
-
/* This is to low_get_line as low_get_program_line_plain is to
-
* low_get_program_line. */
-
PMOD_EXPORT char *low_get_line_plain (PIKE_OPCODE_T *pc, struct program *prog,
-
INT_TYPE *linep, int malloced)
-
{
-
linep[0] = 0;
-
-
if (prog->program && prog->linenumbers) {
-
ptrdiff_t offset = pc - prog->program;
-
-
if ((offset < (ptrdiff_t)prog->num_program) && (offset >= 0)) {
-
char *cnt = prog->linenumbers;
-
INT32 off = 0;
-
INT_TYPE line = 0;
-
char *file = NULL;
-
size_t len = 0;
-
INT32 shift = 0;
-
-
while(cnt < prog->linenumbers + prog->num_linenumbers)
-
{
-
if(*cnt == 127)
-
{
-
cnt++;
-
len = get_small_number(&cnt);
-
shift = *cnt;
-
file = ++cnt;
-
CHECK_FILE_ENTRY (prog, cnt, len, shift);
-
cnt += len<<shift;
-
}
-
off+=get_small_number(&cnt);
-
if(off > offset) break;
-
line+=get_small_number(&cnt);
-
}
-
linep[0]=line;
-
-
if (file) return make_plain_file (file, len, shift, malloced);
-
}
-
}
-
-
return NULL;
-
}
-
-
#ifdef PIKE_DEBUG
-
/* Variants for convenient use from a debugger. */
-
-
void gdb_program_line (struct program *prog)
-
{
-
INT_TYPE line;
-
char *file = low_get_program_line_plain (prog, &line, 0);
-
fprintf (stderr, "%s:%ld\n", file, (long)line);
-
}
-
-
void gdb_get_line (PIKE_OPCODE_T *pc, struct program *prog)
-
{
-
INT_TYPE line;
-
char *file = low_get_line_plain (pc, prog, &line, 0);
-
fprintf (stderr, "%s:%ld\n", file, (long)line);
-
}
-
-
#endif
-
-
/*
-
* return the file in which we were executing. pc should be the
-
* program counter (i.e. the address in prog->program), prog the
-
* current program, and line will be initialized to the line in that
-
* file.
-
*/
-
PMOD_EXPORT struct pike_string *get_line(PIKE_OPCODE_T *pc,
-
struct program *prog,
-
INT_TYPE *linep)
-
{
-
struct pike_string *res;
-
-
if (prog == 0) {
-
struct pike_string *unknown_program;
-
REF_MAKE_CONST_STRING(unknown_program, "Unknown program");
-
linep[0] = 0;
-
return unknown_program;
-
}
-
-
res = low_get_line(pc, prog, linep);
-
if (!res) {
-
struct pike_string *not_found;
-
REF_MAKE_CONST_STRING(not_found, "Line not found");
-
return not_found;
-
}
-
return res;
-
}
-
-
PMOD_EXPORT struct pike_string *low_get_function_line (struct object *o,
-
int fun,
-
INT_TYPE *linep)
-
{
-
if (o->prog) {
-
struct program *p;
-
struct identifier *id;
-
struct pike_string *ret;
-
while (1) {
-
struct external_variable_context loc;
-
struct reference *idref = o->prog->identifier_references + fun;
-
p = PROG_FROM_PTR(o->prog, idref);
-
id = p->identifiers + idref->identifier_offset;
-
if (!IDENTIFIER_IS_ALIAS(id->identifier_flags)) break;
-
loc.o = o;
-
loc.inherit = INHERIT_FROM_INT(o->prog, fun);
-
loc.parent_identifier = fun;
-
find_external_context(&loc, id->func.ext_ref.depth);
-
fun = id->func.ext_ref.id + loc.inherit->identifier_level;
-
o = loc.o;
-
}
-
if (IDENTIFIER_IS_PIKE_FUNCTION(id->identifier_flags) &&
-
(id->func.offset != -1))
-
return low_get_line (p->program + id->func.offset, p, linep);
-
if ((ret = get_identifier_line(o->prog, fun, linep))) {
-
add_ref(ret);
-
return ret;
-
}
-
return low_get_program_line(o->prog, linep);
-
}
-
*linep = 0;
-
return NULL;
-
}
-
-
/* Return the file and line where the identifier with reference number
-
* fun was defined.
-
*
-
* Note: Unlike the other get*line() functions, this one does not
-
* add a reference to the returned string.
-
*/
-
PMOD_EXPORT struct pike_string *get_identifier_line(struct program *p,
-
int fun,
-
INT_TYPE *linep)
-
{
-
struct reference *ref = PTR_FROM_INT(p, fun);
-
struct identifier *id = ID_FROM_PTR(p, ref);
-
p = PROG_FROM_PTR(p, ref);
-
if (id->filename_strno >= p->num_strings) return NULL;
-
if (linep) *linep = id->linenumber;
-
return p->strings[id->filename_strno];
-
}
-
-
/* Main entry point for compiler messages originating from
-
* C-code.
-
*
-
* Sends the message along to PikeCompiler()->report().
-
*
-
* NOTE: The format string fmt (and vargs) is only formatted with
-
* string_builder_vsprintf() if the number of extra
-
* Pike stack arguments (args) is zero.
-
*
-
* NOTE: This function may be called from functions that sometimes
-
* execute outside of the compilation context, eg by
-
* __handle_sprintf_format(), which can be called directly
-
* by Pike-code, in which case it is a NO-OP.
-
*/
-
PMOD_EXPORT void va_yyreport(int severity_level,
-
struct pike_string *file, INT_TYPE line,
-
struct pike_string *system, INT32 args,
-
const char *fmt, va_list vargs)
-
{
-
struct compilation *c = MAYBE_THIS_COMPILATION;
-
struct string_builder s;
-
-
if (!c) {
-
/* No compiler context. */
-
pop_n_elems(args);
-
return;
-
}
-
-
STACK_LEVEL_START(args);
-
-
#ifdef PIKE_DEBUG
-
if(Pike_interpreter.recoveries && Pike_sp-Pike_interpreter.evaluator_stack < Pike_interpreter.recoveries->stack_pointer)
-
Pike_fatal("Stack error (underflow)\n");
-
#endif
-
-
/* Convert type errors to warnings in non-strict compat mode. */
-
if ((system == type_check_system_string) &&
-
(severity_level == REPORT_ERROR) &&
-
(Pike_compiler->compat_major != -1) &&
-
!(c->lex.pragmas & ID_STRICT_TYPES) &&
-
((Pike_compiler->compat_major < PIKE_MAJOR_VERSION) ||
-
((Pike_compiler->compat_major == PIKE_MAJOR_VERSION) &&
-
(Pike_compiler->compat_minor < PIKE_MINOR_VERSION)))) {
-
severity_level = REPORT_WARNING;
-
}
-
-
/* If we have parse errors we might get erroneous warnings,
-
* so don't print them.
-
* This has the additional benefit of making it easier to
-
* visually locate the actual error message.
-
*/
-
if ((severity_level <= REPORT_WARNING) &&
-
Pike_compiler->num_parse_error) {
-
pop_n_elems(args);
-
return;
-
}
-
-
if (severity_level >= REPORT_ERROR) {
-
if (Pike_compiler->num_parse_error > 20) {
-
pop_n_elems(args);
-
return;
-
}
-
Pike_compiler->num_parse_error++;
-
cumulative_parse_error++;
-
}
-
-
push_int(severity_level);
-
ref_push_string(file?file:c->lex.current_file);
-
push_int(line?line:c->lex.current_line);
-
ref_push_string(system);
-
if (args) {
-
int i = args;
-
push_text(fmt);
-
/* Copy the arguments. */
-
while (i--) {
-
push_svalue(Pike_sp-(args+5));
-
}
-
} else {
-
init_string_builder(&s, 0);
-
string_builder_vsprintf(&s, fmt, vargs);
-
push_string(finish_string_builder(&s));
-
}
-
-
safe_apply_current(PC_REPORT_FUN_NUM, args + 5);
-
pop_stack();
-
if (args) pop_n_elems(args);
-
STACK_LEVEL_DONE(0);
-
}
-
-
PMOD_EXPORT void low_yyreport(int severity_level,
-
struct pike_string *file, INT_TYPE line,
-
struct pike_string *system,
-
INT32 args, const char *fmt, ...)
-
{
-
va_list vargs;
-
-
va_start(vargs,fmt);
-
va_yyreport(severity_level, file, line, system, args, fmt, vargs);
-
va_end(vargs);
-
}
-
-
PMOD_EXPORT void yyreport(int severity_level, struct pike_string *system,
-
INT32 args, const char *fmt, ...)
-
{
-
va_list vargs;
-
-
va_start(vargs,fmt);
-
va_yyreport(severity_level, NULL, 0, system, args, fmt, vargs);
-
va_end(vargs);
-
}
-
-
PMOD_EXPORT void yywarning(char *fmt, ...)
-
{
-
va_list vargs;
-
-
va_start(vargs,fmt);
-
va_yyreport(REPORT_WARNING, NULL, 0, parser_system_string, 0, fmt, vargs);
-
va_end(vargs);
-
}
-
-
/* FIXME: Consider converting these to using va_yyreport(). */
-
-
PMOD_EXPORT void my_yyerror(const char *fmt,...)
-
{
-
va_list vargs;
-
va_start(vargs,fmt);
-
va_yyreport(REPORT_ERROR, NULL, 0, parser_system_string, 0, fmt, vargs);
-
va_end(vargs);
-
}
-
-
PMOD_EXPORT void yyerror(const char *str)
-
{
-
my_yyerror("%s", str);
-
}
-
-
/* Main entry point for errors from the type-checking subsystems.
-
*
-
* The message (if any) will be formatted for the same source
-
* position as the got_t.
-
*
-
* The expect_t will be formatted for the same position as the got_t
-
* if there's no expected_file/expected_line.
-
*
-
* The got_t will be formatted for the current lex position if there's
-
* no got_file/got_line.
-
*/
-
void yytype_report(int severity_level,
-
struct pike_string *expected_file, INT_TYPE expected_line,
-
struct pike_type *expected_t,
-
struct pike_string *got_file, INT_TYPE got_line,
-
struct pike_type *got_t,
-
INT32 args, const char *fmt, ...)
-
{
-
if (fmt)
-
{
-
va_list vargs;
-
va_start(vargs, fmt);
-
va_yyreport(severity_level, got_file, got_line, type_check_system_string,
-
args, fmt, vargs);
-
va_end(vargs);
-
}
-
-
if (expected_t && got_t) {
-
yyexplain_nonmatching_types(severity_level,
-
expected_file?expected_file:got_file,
-
expected_line?expected_line:got_line,
-
expected_t,
-
got_file, got_line, got_t);
-
} else if (expected_t) {
-
ref_push_type_value(expected_t);
-
low_yyreport(severity_level,
-
expected_file?expected_file:got_file,
-
expected_line?expected_line:got_line,
-
type_check_system_string,
-
1, "Expected: %O.");
-
} else if (got_t) {
-
ref_push_type_value(got_t);
-
low_yyreport(severity_level, got_file, got_line, type_check_system_string,
-
1, "Got : %O.");
-
}
-
}
-
-
void yytype_error(const char *msg, struct pike_type *expected_t,
-
struct pike_type *got_t, unsigned int flags)
-
{
-
yytype_report((flags & YYTE_IS_WARNING)?REPORT_WARNING:REPORT_ERROR,
-
NULL, 0, expected_t, NULL, 0, got_t, 0, "%s", msg);
-
}
-
-
struct pike_string *format_exception_for_error_msg (struct svalue *thrown)
-
{
-
struct pike_string *s = NULL;
-
-
push_svalue (thrown);
-
SAFE_APPLY_MASTER ("describe_error", 1);
-
-
if (TYPEOF(sp[-1]) == T_STRING) {
-
f_string_trim_all_whites(1);
-
push_constant_text("\n");
-
push_constant_text(" ");
-
f_replace(3);
-
return (--sp)->u.string;
-
}
-
else {
-
pop_stack();
-
return NULL;
-
}
-
}
-
-
void handle_compile_exception (const char *yyerror_fmt, ...)
-
{
-
struct svalue thrown;
-
struct compilation *c = THIS_COMPILATION;
-
-
CHECK_COMPILER();
-
-
move_svalue (&thrown, &throw_value);
-
mark_free_svalue (&throw_value);
-
-
if (yyerror_fmt) {
-
va_list args;
-
va_start (args, yyerror_fmt);
-
va_yyreport(REPORT_ERROR, NULL, 0, parser_system_string, 0,
-
yyerror_fmt, args);
-
va_end (args);
-
}
-
-
push_svalue(&thrown);
-
/* safe_apply_current(PC_FILTER_EXCEPTION_FUN_NUM, 1); */
-
low_safe_apply_handler("compile_exception", c->handler, c->compat_handler, 1);
-
-
if (SAFE_IS_ZERO(sp-1)) {
-
struct pike_string *s = format_exception_for_error_msg (&thrown);
-
if (s) {
-
push_string(s);
-
yyreport(REPORT_ERROR, parser_system_string, 1, "%s");
-
}
-
}
-
-
pop_stack();
-
free_svalue(&thrown);
-
}
-
-
extern int yyparse(void);
-
-
#ifdef PIKE_DEBUG
-
#define do_yyparse() do { \
-
struct svalue *save_sp=Pike_sp; \
-
yyparse(); /* Parse da program */ \
-
if(save_sp != Pike_sp) { \
-
Pike_fatal("yyparse() left %"PRINTPTRDIFFT"d droppings on the stack!\n", \
-
Pike_sp - save_sp); \
-
} \
-
}while(0)
-
#else
-
#define do_yyparse() yyparse()
-
#endif
-
-
struct Supporter *current_supporter=0;
-
-
-
#ifdef PIKE_DEBUG
-
-
struct supporter_marker
-
{
-
struct supporter_marker *next;
-
void *data;
-
int level, verified;
-
};
-
-
#undef EXIT_BLOCK
-
#define EXIT_BLOCK(P)
-
#undef COUNT_OTHER
-
#define COUNT_OTHER()
-
-
#undef INIT_BLOCK
-
#define INIT_BLOCK(X) do { (X)->level = (X)->verified = 0; }while(0)
-
PTR_HASH_ALLOC(supporter_marker, 128);
-
-
static int supnum;
-
-
#define SNUM(X) (get_supporter_marker((X))->level)
-
-
static void mark_supporters(struct Supporter *s)
-
{
-
struct supporter_marker *m;
-
-
if(!s) return;
-
debug_malloc_touch(s);
-
m=get_supporter_marker(s);
-
-
if(m->level) return;
-
m->level = -1;
-
-
if(s->magic != 0x500b0127)
-
{
-
#ifdef DEBUG_MALLOC
-
describe(s);
-
#endif
-
Pike_fatal("This is not a supporter (addr=%p, magic=%x)!\n",s,s->magic);
-
}
-
-
mark_supporters(s->dependants);
-
mark_supporters(s->next_dependant);
-
-
m->level=supnum++;
-
-
mark_supporters(s->previous);
-
mark_supporters(s->depends_on);
-
}
-
-
static void low_verify_supporters(struct Supporter *s)
-
{
-
struct Supporter *ss;
-
struct supporter_marker *m;
-
-
if(!s) return;
-
debug_malloc_touch(s);
-
m=get_supporter_marker(s);
-
-
if(m->verified) return;
-
m->verified = 1;
-
-
low_verify_supporters(s->dependants);
-
low_verify_supporters(s->next_dependant);
-
-
#if 0
-
fprintf(stderr, "low_verify_supporters %p%s, level %d: "
-
"previous %p, depends_on %p, dependants %p, next_dependant %p\n",
-
s, s == current_supporter ? " == current_supporter" : "",
-
m->level, s->previous, s->depends_on, s->dependants, s->next_dependant);
-
#endif
-
-
if(s->previous && SNUM(s->previous) <= m->level)
-
Pike_fatal("Que, numbers out of whack1\n");
-
-
if(s->depends_on && SNUM(s->depends_on) <= m->level)
-
Pike_fatal("Que, numbers out of whack2\n");
-
-
for(ss=s->dependants;ss;ss=ss->next_dependant) {
-
if (ss->depends_on != s)
-
Pike_fatal("Dependant hasn't got depends_on set properly.\n");
-
if(SNUM(ss) >= m->level)
-
Pike_fatal("Que, numbers out of whack3\n");
-
}
-
-
low_verify_supporters(s->previous);
-
low_verify_supporters(s->depends_on);
-
}
-
-
void verify_supporters()
-
{
-
if(d_flag)
-
{
-
supnum=1;
-
init_supporter_marker_hash();
-
-
#if 0
-
fprintf(stderr, "verify_supporters start\n");
-
#endif
-
-
mark_supporters(current_supporter);
-
low_verify_supporters(current_supporter);
-
#ifdef DO_PIKE_CLEANUP
-
{
-
size_t e=0;
-
for(e=0;e<supporter_marker_hash_table_size;e++)
-
while(supporter_marker_hash_table[e])
-
remove_supporter_marker(supporter_marker_hash_table[e]->data);
-
}
-
#endif
-
exit_supporter_marker_hash();
-
-
#if 0
-
fprintf(stderr, "verify_supporters end\n");
-
#endif
-
}
-
}
-
#else
-
#define verify_supporters();
-
#endif
-
-
void init_supporter(struct Supporter *s,
-
supporter_callback *fun,
-
void *data)
-
{
-
CDFPRINTF((stderr, "th(%ld) init_supporter() supporter=%p data=%p.\n",
-
(long) th_self(), s, data));
-
verify_supporters();
-
#ifdef PIKE_DEBUG
-
s->magic = 0x500b0127;
-
#endif
-
s->previous=current_supporter;
-
current_supporter=s;
-
-
s->depends_on=0;
-
s->dependants=0;
-
s->next_dependant=0;
-
s->fun=fun;
-
s->data=data;
-
s->prog=0;
-
verify_supporters();
-
}
-
-
int unlink_current_supporter(struct Supporter *c)
-
{
-
int ret=0;
-
#ifdef PIKE_DEBUG
-
if(c != current_supporter)
-
Pike_fatal("Previous unlink failed.\n");
-
#endif
-
debug_malloc_touch(c);
-
verify_supporters();
-
if(c->depends_on)
-
{
-
#ifdef PIKE_DEBUG
-
struct Supporter *s;
-
for (s = c->depends_on->dependants; s; s = s->next_dependant)
-
if (s == c) Pike_fatal("Dependant already linked in.\n");
-
#endif
-
ret++;
-
c->next_dependant = c->depends_on->dependants;
-
c->depends_on->dependants=c;
-
add_ref(c->self);
-
CDFPRINTF((stderr, "th(%ld) unlink_current_supporter() "
-
"supporter=%p (prog %p) depends on %p (prog %p).\n",
-
(long) th_self(), c, c->prog,
-
c->depends_on, c->depends_on->prog));
-
}
-
current_supporter=c->previous;
-
verify_supporters();
-
return ret;
-
}
-
-
void free_supporter(struct Supporter *c)
-
{
-
verify_supporters();
-
if (c->depends_on) {
-
struct Supporter **s;
-
for (s = &c->depends_on->dependants; *s; s = &(*s)->next_dependant)
-
if (*s == c) {*s = c->next_dependant; break;}
-
c->depends_on = 0;
-
}
-
verify_supporters();
-
}
-
-
int call_dependants(struct Supporter *s, int finish)
-
{
-
int ok = 1;
-
struct Supporter *tmp;
-
CDFPRINTF((stderr, "th(%ld) call_dependants() supporter=%p (prog %p) "
-
"finish=%d.\n", (long) th_self(), s, s->prog, finish));
-
verify_supporters();
-
while((tmp=s->dependants))
-
{
-
CDFPRINTF((stderr, "th(%ld) dependant: %p (prog %p) (data:%p).\n",
-
(long) th_self(), tmp, tmp->prog, tmp->data));
-
s->dependants=tmp->next_dependant;
-
#ifdef PIKE_DEBUG
-
tmp->next_dependant=0;
-
#endif
-
verify_supporters();
-
if (!tmp->fun(tmp->data, finish)) ok = 0;
-
verify_supporters();
-
free_object(tmp->self);
-
}
-
return ok;
-
}
-
-
int report_compiler_dependency(struct program *p)
-
{
-
int ret=0;
-
struct Supporter *c,*cc;
-
-
if (p == Pike_compiler->new_program) {
-
/* Depends on self... */
-
return 0;
-
}
-
-
CDFPRINTF((stderr, "th(%ld) compiler dependency on %p from %p\n",
-
(long)th_self(), p, Pike_compiler->new_program));
-
-
verify_supporters();
-
if (Pike_compiler->flags & COMPILATION_FORCE_RESOLVE)
-
return 0;
-
for(cc=current_supporter;cc;cc=cc->previous)
-
{
-
if(cc->prog &&
-
!(cc->prog->flags & PROGRAM_PASS_1_DONE))
-
{
-
c=cc->depends_on;
-
if(!c) c=cc->previous;
-
for(;c;c=c->previous)
-
{
-
if(c->prog == p)
-
{
-
cc->depends_on=c;
-
CDFPRINTF ((stderr, "th(%ld) supporter %p (prog %p) "
-
"now depends on %p (prog %p)\n",
-
(long) th_self(), cc, cc->prog, c, c->prog));
-
verify_supporters();
-
ret++; /* dependency registred */
-
}
-
}
-
}
-
}
-
verify_supporters();
-
return ret;
-
}
-
-
/*! @class Reporter
-
*!
-
*! API for reporting parse errors and similar.
-
*/
-
-
/*! @decl enum SeverityLevel
-
*! Message severity level.
-
*! { NOTICE, WARNING, ERROR, FATAL }
-
*!
-
*! @constant NOTICE
-
*! @constant WARNING
-
*! @constant ERROR
-
*! @constant FATAL
-
*!
-
*! @seealso
-
*! @[report()]
-
*/
-
-
/*! @decl void report(SeverityLevel severity, @
-
*! string filename, int linenumber, @
-
*! string subsystem, @
-
*! string message, mixed ... extra_args)
-
*!
-
*! Report a diagnostic from the compiler.
-
*!
-
*! @param severity
-
*! The severity of the diagnostic.
-
*!
-
*! @param filename
-
*! @param linenumber
-
*! Location which triggered the diagnostic.
-
*!
-
*! @param subsystem
-
*! Compiler subsystem that generated the diagnostic.
-
*!
-
*! @param message
-
*! @[sprintf()]-style formatting string with the diagnostic message.
-
*!
-
*! @param extra_args
-
*! Extra arguments to @[sprintf()].
-
*!
-
*! The default implementation does the following:
-
*!
-
*! @ul
-
*! @item
-
*! If there's a @[MasterObject()->report()], call it
-
*! with the same arguments as ourselves.
-
*! @item
-
*! Otherwise depending on @[severity]:
-
*! @int
-
*! @value NOTICE
-
*! Ignored.
-
*! @value WARNING
-
*! Calls @[MasterObject()->compile_warning()].
-
*! @value ERROR
-
*! @value FATAL
-
*! Calls @[MasterObject()->compile_error()].
-
*! @endint
-
*! @endul
-
*!
-
*! If there's no master object yet, the diagnostic is output to
-
*! @[Stdio.stderr].
-
*!
-
*! @note
-
*! In Pike 7.8 and earlier @[MasterObject()->report()] was not called.
-
*!
-
*! @seealso
-
*! @[PikeCompiler()->report()]
-
*/
-
/* NOTE: This function MUST NOT use any storage in the Reporter program! */
-
static void f_reporter_report(INT32 args)
-
{
-
int level;
-
struct pike_string *filename;
-
INT_TYPE linenumber;
-
struct pike_string *subsystem;
-
struct pike_string *message;
-
struct object *master_ob;
-
-
if ((master_ob = get_master()) && master_ob->prog) {
-
int fun = find_identifier("report", master_ob->prog);
-
if (fun >= 0) {
-
apply_low(master_ob, fun, args);
-
return;
-
}
-
}
-
-
if (args > 5) {
-
f_sprintf(args - 4);
-
args = 5;
-
}
-
get_all_args("report", args, "%d%W%i%W%W",
-
&level, &filename, &linenumber, &subsystem, &message);
-
-
/* Ignore informational level messages */
-
if (level >= REPORT_WARNING) {
-
if (master_ob && master_ob->prog) {
-
ref_push_string(filename);
-
push_int(linenumber);
-
ref_push_string(message);
-
if (level >= REPORT_ERROR) {
-
APPLY_MASTER("compile_error", 3);
-
args++;
-
} else {
-
APPLY_MASTER("compile_warning", 3);
-
args++;
-
}
-
} else {
-
/* We hope that errors from compiling the master
-
* won't contain wide-strings... */
-
if (level >= REPORT_ERROR) {
-
fprintf(stderr, "%s:%ld: %s\n",
-
filename->str, (long)linenumber, message->str);
-
} else {
-
fprintf(stderr, "%s:%ld: Warning: %s\n",
-
filename->str, (long)linenumber, message->str);
-
}
-
fflush(stderr);
-
}
-
}
-
pop_n_elems(args);
-
push_int(0);
-
}
-
-
/*! @endclass
-
*/
-
-
/*! @module DefaultCompilerEnvironment
-
*!
-
*! The @[CompilerEnvironment] object that is used
-
*! for loading C-modules and by @[predef::compile()].
-
*!
-
*! @note
-
*! @[predef::compile()] is essentially an alias for the
-
*! @[CompilerEnvironment()->compile()] in this object.
-
*!
-
*! @seealso
-
*! @[CompilerEnvironment], @[predef::compile()]
-
*/
-
-
/*! @endmodule
-
*/
-
-
/*! @class CompilerEnvironment
-
*!
-
*! The compiler environment.
-
*!
-
*! By inheriting this class and overloading the functions,
-
*! it is possible to make a custom Pike compiler.
-
*!
-
*! @note
-
*! Prior to Pike 7.8 this sort of customization has to be done
-
*! either via custom master objects, or via @[CompilationHandler]s.
-
*!
-
*! @seealso
-
*! @[CompilationHandler], @[MasterObject], @[master()], @[replace_master()]
-
*/
-
-
/*! @decl inherit Reporter
-
*!
-
*! Implements the @[Reporter] API.
-
*!
-
*! @seealso
-
*! @[Reporter()->report()], @[Reporter()->SeverityLevel]
-
*/
-
-
/*! @decl program compile(string source, CompilationHandler|void handler, @
-
*! int|void major, int|void minor,@
-
*! program|void target, object|void placeholder)
-
*!
-
*! Compile a string to a program.
-
*!
-
*! This function takes a piece of Pike code as a string and
-
*! compiles it into a clonable program.
-
*!
-
*! The optional argument @[handler] is used to specify an alternative
-
*! error handler. If it is not specified the current master object will
-
*! be used.
-
*!
-
*! The optional arguments @[major] and @[minor] are used to tell the
-
*! compiler to attempt to be compatible with Pike @[major].@[minor].
-
*!
-
*! @note
-
*! This function essentially performs
-
*! @code
-
*! program compile(mixed ... args)
-
*! {
-
*! return PikeCompiler(@@args)->compile();
-
*! }
-
*! @endcode
-
*!
-
*! @note
-
*! Note that @[source] must contain the complete source for a program.
-
*! It is not possible to compile a single expression or statement.
-
*!
-
*! Also note that @[compile()] does not preprocess the program.
-
*! To preprocess the program you can use @[compile_string()] or
-
*! call the preprocessor manually by calling @[cpp()].
-
*!
-
*! @seealso
-
*! @[compile_string()], @[compile_file()], @[cpp()], @[master()],
-
*! @[CompilationHandler]
-
*/
-
static void f_compilation_env_compile(INT32 args)
-
{
-
apply_current(CE_PIKE_COMPILER_FUN_NUM, args);
-
args = 1;
-
if (TYPEOF(Pike_sp[-1]) != T_OBJECT) {
-
Pike_error("Bad return value from PikeCompiler().\n");
-
}
-
apply(Pike_sp[-1].u.object, "compile", 0);
-
stack_pop_n_elems_keep_top(args);
-
}
-
-
/*! @decl mixed resolv(string identifier, string filename, @
-
*! object|void handler)
-
*/
-
static void f_compilation_env_resolv(INT32 args)
-
{
-
struct pike_string *ident;
-
struct pike_string *filename;
-
struct object *handler = NULL;
-
-
get_all_args("resolv", args, "%W%W.%O",
-
&ident, &filename, &handler);
-
-
if(get_master())
-
{
-
DECLARE_CYCLIC();
-
if(BEGIN_CYCLIC(ident, filename))
-
{
-
my_yyerror("Recursive module dependency in %S.", ident);
-
}else{
-
SET_CYCLIC_RET(1);
-
-
APPLY_MASTER("resolv", args);
-
}
-
END_CYCLIC();
-
} else {
-
pop_n_elems(args);
-
push_undefined();
-
}
-
}
-
-
/*! @decl object get_compilation_handler(int major, int minor)
-
*!
-
*! Get compatibility handler for Pike @[major].@[minor].
-
*!
-
*! The default implementation calls the corresponding
-
*! function in the master object.
-
*!
-
*! @note
-
*! This function is typically called by
-
*! @[PikeCompiler()->get_compilation_handler()].
-
*!
-
*! @seealso
-
*! @[MasterObject()->get_compilation_handler()].
-
*/
-
static void f_compilation_env_get_compilation_handler(INT32 args)
-
{
-
if(get_master())
-
{
-
APPLY_MASTER("get_compilation_handler", args);
-
} else {
-
pop_n_elems(args);
-
push_undefined();
-
}
-
}
-
-
/*! @decl mapping(string:mixed)|object get_default_module()
-
*!
-
*! Get the default module for the current compatibility level
-
*! (ie typically the value returned by @[predef::all_constants()]).
-
*!
-
*! The default implementation calls the corresponding function
-
*! in the master object.
-
*!
-
*! @returns
-
*! @mixed
-
*! @type mapping(string:mixed)|object
-
*! Constant table to use.
-
*!
-
*! @type int(0..0)
-
*! Use the builtin constant table.
-
*! @endmixed
-
*!
-
*! @note
-
*! This function is typically called by
-
*! @[Pike_compiler()->get_default_module()].
-
*!
-
*! @seealso
-
*! @[MasterObject()->get_default_module()].
-
*/
-
static void f_compilation_env_get_default_module(INT32 args)
-
{
-
if(get_master())
-
{
-
APPLY_MASTER("get_default_module", args);
-
} else {
-
pop_n_elems(args);
-
push_undefined();
-
}
-
}
-
-
/*! @decl program handle_inherit(string inh, string current_file, @
-
*! object|void handler)
-
*!
-
*! Look up an inherit @[inh].
-
*!
-
*! The default implementation calls the corresponding function
-
*! in the master object.
-
*!
-
*! @seealso
-
*! @[MasterObject()->handle_inherit()].
-
*/
-
static void f_compilation_env_handle_inherit(INT32 args)
-
{
-
if(get_master())
-
{
-
APPLY_MASTER("handle_inherit", args);
-
} else {
-
pop_n_elems(args);
-
push_undefined();
-
}
-
}
-
-
/*! @decl int filter_exception(SeverityLevel level, mixed err)
-
*!
-
*! The default implementation calls
-
*! @[MasterObject()->compile_exception()] for @[level] @[ERROR]
-
*! and @[FATAL].
-
*!
-
*! @note
-
*! This function is not implemented in Pike 7.8.
-
*!
-
*! @seealso
-
*! @[MasterObject()->compile_exception()].
-
*/
-
static void f_compilation_env_filter_exception(INT32 args)
-
{
-
int level;
-
struct svalue *err;
-
-
get_all_args("filter_exception", args, "%d%*", &level, &err);
-
if (args > 2) {
-
pop_n_elems(args-2);
-
args = 2;
-
}
-
-
#if 0
-
if (level >= REPORT_WARNING) {
-
if (level >= REPORT_ERROR) {
-
APPLY_MASTER("compile_exception", 1);
-
/* FIXME! */
-
} else {
-
push_int(level);
-
push_string(format_exception_for_error_msg(err));
-
/* FIXME! */
-
}
-
}
-
#endif
-
-
pop_n_elems(args);
-
push_undefined();
-
return;
-
}
-
-
/*! @class PikeCompiler
-
*!
-
*! The Pike compiler.
-
*!
-
*! An object of this class compiles a single string
-
*! of Pike code.
-
*/
-
-
static void free_compilation(struct compilation *c)
-
{
-
debug_malloc_touch(c);
-
if (c->prog) {
-
free_string(c->prog);
-
c->prog = NULL;
-
}
-
if(c->handler) {
-
free_object(c->handler);
-
c->handler = NULL;
-
}
-
if(c->compat_handler) {
-
free_object(c->compat_handler);
-
c->compat_handler = NULL;
-
}
-
if(c->target) {
-
free_program(c->target);
-
c->target = NULL;
-
}
-
if(c->p) {
-
free_program(c->p);
-
c->p = NULL;
-
}
-
if(c->placeholder) {
-
free_object(c->placeholder);
-
c->placeholder = NULL;
-
}
-
if(c->lex.current_file) {
-
free_string(c->lex.current_file);
-
c->lex.current_file = NULL;
-
}
-
if (c->resolve_cache) {
-
free_mapping(c->resolve_cache);
-
c->resolve_cache = NULL;
-
}
-
free_svalue(& c->default_module);
-
SET_SVAL(c->default_module, T_INT, NUMBER_NUMBER, integer, 0);
-
free_supporter(&c->supporter);
-
verify_supporters();
-
}
-
-
static void run_init(struct compilation *c)
-
{
-
debug_malloc_touch(c);
-
-
if (c->compat_handler) free_object(c->compat_handler);
-
c->compat_handler=0;
-
-
if (c->resolve_cache) {
-
free_mapping(c->resolve_cache);
-
c->resolve_cache = 0;
-
}
-
-
c->lex.current_line=1;
-
free_string(c->lex.current_file);
-
c->lex.current_file=make_shared_string("-");
-
-
if (runtime_options & RUNTIME_STRICT_TYPES)
-
{
-
c->lex.pragmas = ID_STRICT_TYPES;
-
} else {
-
c->lex.pragmas = 0;
-
}
-
-
c->lex.end = c->prog->str + (c->prog->len << c->prog->size_shift);
-
-
switch(c->prog->size_shift)
-
{
-
case 0: c->lex.current_lexer = yylex0; break;
-
case 1: c->lex.current_lexer = yylex1; break;
-
case 2: c->lex.current_lexer = yylex2; break;
-
#ifdef PIKE_DEBUG
-
default:
-
Pike_fatal("Program has bad shift %d!\n", c->prog->size_shift);
-
break;
-
#endif
-
}
-
-
c->lex.pos=c->prog->str;
-
}
-
-
static void run_init2(struct compilation *c)
-
{
-
#if 0
-
int i;
-
struct program *p;
-
struct reference *refs;
-
#endif /* 0 */
-
debug_malloc_touch(c);
-
Pike_compiler->compiler = c;
-
-
/* Get the proper default module. */
-
safe_apply_current2(PC_GET_DEFAULT_MODULE_FUN_NUM, 0, NULL);
-
if(TYPEOF(Pike_sp[-1]) == T_INT)
-
{
-
pop_stack();
-
ref_push_mapping(get_builtin_constants());
-
}
-
assign_svalue(&c->default_module, Pike_sp-1);
-
pop_stack();
-
-
use_module(& c->default_module);
-
-
Pike_compiler->compat_major=PIKE_MAJOR_VERSION;
-
Pike_compiler->compat_minor=PIKE_MINOR_VERSION;
-
-
if(c->major>=0)
-
change_compiler_compatibility(c->major, c->minor);
-
-
#if 0
-
/* Make all inherited private symbols that weren't overloaded
-
* in the first pass local.
-
*/
-
p = c->new_program;
-
i = p->num_identifier_references;
-
refs = p->identifier_references;
-
while (i--) {
-
if (refs[i].id_flags & ID_PRIVATE) refs[i].id_flags |= ID_INLINE;
-
}
-
#endif /* 0 */
-
}
-
-
static void run_exit(struct compilation *c)
-
{
-
debug_malloc_touch(c);
-
-
#ifdef PIKE_DEBUG
-
if(c->num_used_modules)
-
Pike_fatal("Failed to pop modules properly.\n");
-
#endif
-
-
#ifdef PIKE_DEBUG
-
if (c->compilation_depth != -1) {
-
fprintf(stderr, "compile(): compilation_depth is %d\n",
-
c->compilation_depth);
-
}
-
#endif /* PIKE_DEBUG */
-
-
if (c->resolve_cache) {
-
free_mapping(c->resolve_cache);
-
c->resolve_cache = NULL;
-
}
-
-
verify_supporters();
-
}
-
-
static void zap_placeholder(struct compilation *c)
-
{
-
/* fprintf(stderr, "Destructing placeholder.\n"); */
-
if (c->placeholder->storage) {
-
yyerror("Placeholder already has storage!");
-
#if 0
-
fprintf(stderr, "Placeholder already has storage!\n"
-
"placeholder: %p, storage: %p, prog: %p\n",
-
c->placeholder, c->placeholder->storage, c->placeholder->prog);
-
#endif
-
debug_malloc_touch(c->placeholder);
-
destruct(c->placeholder);
-
} else {
-
/* FIXME: Is this correct? */
-
/* It would probably be nicer if it was possible to just call
-
* destruct on the object, but this works too. -Hubbe
-
*/
-
free_program(c->placeholder->prog);
-
c->placeholder->prog = NULL;
-
debug_malloc_touch(c->placeholder);
-
}
-
free_object(c->placeholder);
-
c->placeholder=0;
-
verify_supporters();
-
}
-
-
/* NOTE: Must not throw errors! */
-
static int run_pass1(struct compilation *c)
-
{
-
int ret=0;
-
-
debug_malloc_touch(c);
-
run_init(c);
-
-
#if 0
-
CDFPRINTF((stderr, "th(%ld) compile() starting compilation_depth=%d\n",
-
(long)th_self(), c->compilation_depth));
-
#endif
-
-
if(c->placeholder && c->placeholder->prog != null_program) {
-
yyerror("Placeholder object is not a null_program clone!");
-
return 0;
-
}
-
debug_malloc_touch(c->placeholder);
-
-
if(c->target && !(c->target->flags & PROGRAM_VIRGIN)) {
-
yyerror("Placeholder program is not virgin!");
-
return 0;
-
}
-
-
low_start_new_program(c->target,1,0,0,0);
-
c->supporter.prog = Pike_compiler->new_program;
-
-
CDFPRINTF((stderr,
-
"th(%ld) %p run_pass1() start: "
-
"threads_disabled:%d, compilation_depth:%d\n",
-
(long)th_self(), Pike_compiler->new_program,
-
threads_disabled, c->compilation_depth));
-
-
run_init2(c);
-
-
if(c->placeholder)
-
{
-
if(c->placeholder->prog != null_program)
-
{
-
yyerror("Placeholder argument is not a null_program clone!");
-
c->placeholder=0;
-
debug_malloc_touch(c->placeholder);
-
}else{
-
free_program(c->placeholder->prog);
-
add_ref(c->placeholder->prog=Pike_compiler->new_program);
-
debug_malloc_touch(c->placeholder);
-
}
-
}
-
-
#if 0
-
CDFPRINTF((stderr, "th(%ld) %p compile(): First pass\n",
-
(long)th_self(), Pike_compiler->new_program));
-
#endif
-
-
do_yyparse(); /* Parse da program */
-
-
if (!Pike_compiler->new_program->num_linenumbers) {
-
/* The lexer didn't write an initial entry. */
-
store_linenumber(0, c->lex.current_file);
-
#ifdef DEBUG_MALLOC
-
if(strcmp(c->lex.current_file->str,"-"))
-
debug_malloc_name(Pike_compiler->new_program, c->lex.current_file->str, 0);
-
#endif
-
}
-
-
CDFPRINTF((stderr, "th(%ld) %p run_pass1() done for %s\n",
-
(long)th_self(), Pike_compiler->new_program,
-
c->lex.current_file->str));
-
-
ret=unlink_current_supporter(& c->supporter);
-
-
c->p=debug_malloc_pass(end_first_pass(0));
-
-
run_exit(c);
-
-
if(c->placeholder)
-
{
-
if(!c->p || (c->placeholder->storage))
-
{
-
debug_malloc_touch(c->placeholder);
-
zap_placeholder(c);
-
} else {
-
#ifdef PIKE_DEBUG
-
if (c->placeholder->prog != c->p)
-
Pike_fatal("Placeholder object got wrong program after first pass.\n");
-
#endif
-
debug_malloc_touch(c->placeholder);
-
c->placeholder->storage=c->p->storage_needed ?
-
(char *)xcalloc(c->p->storage_needed, 1) :
-
(char *)NULL;
-
call_c_initializers(c->placeholder);
-
}
-
}
-
-
verify_supporters();
-
return ret;
-
}
-
-
void run_pass2(struct compilation *c)
-
{
-
debug_malloc_touch(c);
-
debug_malloc_touch(c->placeholder);
-
-
if (!c->p) {
-
c->flags &= ~(COMPILER_BUSY);
-
c->flags |= COMPILER_DONE;
-
return;
-
}
-
-
run_init(c);
-
low_start_new_program(c->p,2,0,0,0);
-
free_program(c->p);
-
c->p=0;
-
-
run_init2(c);
-
-
CDFPRINTF((stderr,
-
"th(%ld) %p run_pass2() start: "
-
"threads_disabled:%d, compilation_depth:%d\n",
-
(long)th_self(), Pike_compiler->new_program,
-
threads_disabled, c->compilation_depth));
-
-
verify_supporters();
-
-
do_yyparse(); /* Parse da program */
-
-
CDFPRINTF((stderr, "th(%ld) %p run_pass2() done for %s\n",
-
(long)th_self(), Pike_compiler->new_program,
-
c->lex.current_file->str));
-
-
verify_supporters();
-
-
c->p=debug_malloc_pass(end_program());
-
-
run_exit(c);
-
}
-
-
static void run_cleanup(struct compilation *c, int delayed)
-
{
-
debug_malloc_touch(c);
-
debug_malloc_touch(c->placeholder);
-
#if 0 /* FIXME */
-
if (threads_disabled != c->saved_threads_disabled) {
-
Pike_fatal("compile(): threads_disabled:%d saved_threads_disabled:%d\n",
-
threads_disabled, c->saved_threads_disabled);
-
}
-
#endif /* PIKE_DEBUG */
-
-
exit_threads_disable(NULL);
-
-
CDFPRINTF((stderr,
-
"th(%ld) %p run_cleanup(): "
-
"threads_disabled:%d, compilation_depth:%d\n",
-
(long)th_self(), c->target,
-
threads_disabled, c->compilation_depth));
-
if (!c->p)
-
{
-
/* fprintf(stderr, "Destructing placeholder.\n"); */
-
if(c->placeholder) {
-
debug_malloc_touch(c->placeholder);
-
zap_placeholder(c);
-
}
-
-
if(delayed && c->target)
-
{
-
struct program *p = c->target;
-
-
/* Free the constants in the failed program, to untangle the
-
* cyclic references we might have to this program, typically
-
* in parent pointers in nested classes. */
-
if (p->constants) {
-
int i;
-
for (i = 0; i < p->num_constants; i++) {
-
free_svalue(&p->constants[i].sval);
-
SET_SVAL(p->constants[i].sval, T_INT, NUMBER_NUMBER,
-
integer, 0);
-
}
-
}
-
-
/* We have to notify the master object that
-
* a previous compile() actually failed, even
-
* if we did not know it at the time
-
*/
-
CDFPRINTF((stderr, "th(%ld) %p unregistering failed delayed compile.\n",
-
(long) th_self(), p));
-
ref_push_program(p);
-
/* FIXME: Shouldn't the compilation handler be used here? */
-
SAFE_APPLY_MASTER("unregister",1);
-
pop_stack();
-
-
{
-
#ifdef PIKE_DEBUG
-
int refs = p->refs;
-
#endif
-
-
/* Free the target here to avoid false alarms in the debug
-
* check below. */
-
free_program (c->target);
-
c->target = NULL;
-
-
#ifdef PIKE_DEBUG
-
if (refs > 1) {
-
/* Other programs can have indexed out constants from p, which
-
* might be broken themselves and/or keep references to p
-
* through the parent pointer. We should find all those other
-
* programs and invalidate them too, but how can that be done?
-
* The whole delayed compilation thingie is icky icky icky... :P
-
* /mast */
-
fprintf(stderr, "Warning: Program %p still got %d "
-
"external refs after unregister:\n", p, p->refs);
-
locate_references(p);
-
fprintf (stderr, "Describing program:\n");
-
describe_something (p, T_PROGRAM, 0, 0, 0, NULL);
-
}
-
#endif
-
}
-
}
-
}
-
else
-
{
-
if (c->placeholder)
-
{
-
if (c->target->flags & PROGRAM_FINISHED) {
-
JMP_BUF rec;
-
/* Initialize the placeholder. */
-
#ifdef PIKE_DEBUG
-
if (c->placeholder->prog != c->p)
-
Pike_fatal("Placeholder object got wrong program after second pass.\n");
-
#endif
-
if(SETJMP(rec))
-
{
-
handle_compile_exception (NULL);
-
debug_malloc_touch(c->placeholder);
-
zap_placeholder(c);
-
}else{
-
debug_malloc_touch(c->placeholder);
-
call_pike_initializers(c->placeholder,0);
-
}
-
UNSETJMP(rec);
-
}
-
else {
-
debug_malloc_touch(c->placeholder);
-
zap_placeholder(c);
-
}
-
}
-
}
-
verify_supporters();
-
c->flags &= ~(COMPILER_BUSY);
-
c->flags |= COMPILER_DONE;
-
}
-
-
static int call_delayed_pass2(struct compilation *cc, int finish)
-
{
-
int ok = 0;
-
debug_malloc_touch(cc);
-
-
debug_malloc_touch(cc->p);
-
-
CDFPRINTF((stderr, "th(%ld) %p %s delayed compile.\n",
-
(long) th_self(), cc->p, finish ? "continuing" : "cleaning up"));
-
-
/* Reenter the delayed compilation. */
-
add_ref(cc->supporter.self);
-
low_enter_compiler(cc->supporter.self, cc->compilation_inherit);
-
-
if(finish && cc->p) run_pass2(cc);
-
run_cleanup(cc,1);
-
-
exit_compiler();
-
-
debug_malloc_touch(cc);
-
-
#ifdef PIKE_DEBUG
-
if(cc->supporter.dependants)
-
Pike_fatal("Que???\n");
-
#endif
-
if(cc->p) {
-
ok = finish;
-
free_program(cc->p); /* later */
-
cc->p = NULL;
-
}
-
-
CDFPRINTF((stderr, "th(%ld) %p delayed compile %s.\n",
-
(long) th_self(), cc->target, ok ? "done" : "failed"));
-
-
verify_supporters();
-
-
return ok;
-
}
-
-
static void compilation_event_handler(int e)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
-
switch (e) {
-
case PROG_EVENT_INIT:
-
CDFPRINTF((stderr, "th(%ld) compilation: INIT(%p).\n",
-
(long) th_self(), c));
-
MEMSET(c, 0, sizeof(*c));
-
c->supporter.self = Pike_fp->current_object; /* NOTE: Not ref-counted! */
-
c->compilation_inherit =
-
Pike_fp->context - Pike_fp->current_object->prog->inherits;
-
initialize_buf(&c->used_modules);
-
SET_SVAL(c->default_module, T_MAPPING, 0, mapping, get_builtin_constants());
-
add_ref(c->default_module.u.mapping);
-
c->major = -1;
-
c->minor = -1;
-
c->lex.current_line = 1;
-
c->lex.current_file = make_shared_string("-");
-
c->compilation_depth = -1;
-
break;
-
case PROG_EVENT_EXIT:
-
CDFPRINTF((stderr, "th(%ld) compilation: EXIT(%p).\n",
-
(long) th_self(), c));
-
toss_buffer(&c->used_modules);
-
free_compilation(c);
-
break;
-
}
-
}
-
-
/*! @decl void report(SeverityLevel severity, @
-
*! string filename, int linenumber, @
-
*! string subsystem, @
-
*! string message, mixed ... extra_args)
-
*!
-
*! Report a diagnostic from the compiler.
-
*!
-
*! The default implementation attempts to call the first
-
*! corresponding function in the active handlers in priority order:
-
*!
-
*! @ol
-
*! @item
-
*! Call handler->report().
-
*! @item
-
*! Call handler->compile_warning() or handler->compile_error()
-
*! depending on @[severity].
-
*! @item
-
*! Call compat->report().
-
*! @item
-
*! Call compat->compile_warning() or compat->compile_error()
-
*! depending on @[severity].
-
*! @item
-
*! Fallback: Call @[CompilerEnvironment()->report()]
-
*! in the parent object.
-
*! @endol
-
*!
-
*! The arguments will be as follows:
-
*! @dl
-
*! @item report()
-
*! The report() function will be called with the same arguments
-
*! as this function.
-
*! @item compile_warning()/compile_error()
-
*! Depending on the @[severity] either compile_warning()
-
*! or compile_error() will be called.
-
*!
-
*! They will be called with the @[filename], @[linenumber]
-
*! and formatted @[message] as arguments.
-
*!
-
*! Note that these will not be called for the @[NOTICE] severity,
-
*! and that compile_error() will be used for both @[ERROR] and
-
*! @[FATAL].
-
*! @enddl
-
*!
-
*! @note
-
*! In Pike 7.8 and earlier the report() function was not called
-
*! in the handlers.
-
*!
-
*! @seealso
-
*! @[CompilerEnvironment()->report()]
-
*/
-
static void f_compilation_report(INT32 args)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
int level;
-
struct pike_string *filename;
-
INT_TYPE linenumber;
-
struct pike_string *subsystem;
-
struct pike_string *message;
-
struct object *handler = NULL;
-
int fun = -1;
-
-
/* FIXME: get_all_args() ought to have a marker
-
* indicating that we accept more arguments...
-
*/
-
get_all_args("report", args, "%d", &level);
-
-
if ((c->handler || c->compat_handler)) {
-
const char *fun_name = "compile_warning";
-
-
if (level >= REPORT_ERROR) fun_name = "compile_error";
-
-
if((handler = c->handler) && handler->prog) {
-
if ((fun = find_identifier("report", handler->prog)) != -1) {
-
apply_low(handler, fun, args);
-
return;
-
}
-
if ((fun = find_identifier(fun_name, handler->prog)) != -1) {
-
goto apply_handler;
-
}
-
}
-
if ((handler = c->compat_handler) && handler->prog) {
-
if ((fun = find_identifier("report", handler->prog)) != -1) {
-
apply_low(handler, fun, args);
-
return;
-
}
-
if ((fun = find_identifier(fun_name, handler->prog)) != -1) {
-
goto apply_handler;
-
}
-
}
-
}
-
/* Nothing apropriate in any handlers.
-
* Call the report() in our parent.
-
*/
-
apply_external(1, CE_REPORT_FUN_NUM, args);
-
return;
-
-
apply_handler:
-
/* Ignore informational level messages */
-
if (level < REPORT_WARNING) return;
-
if (args > 5) {
-
f_sprintf(args - 4);
-
args = 5;
-
}
-
get_all_args("report", args, "%d%W%i%W%W",
-
&level, &filename, &linenumber,
-
&subsystem, &message);
-
-
ref_push_string(filename);
-
push_int(linenumber);
-
ref_push_string(message);
-
apply_low(handler, fun, 3);
-
stack_pop_n_elems_keep_top(args);
-
}
-
-
/*! @decl void create(string|void source, @
-
*! CompilationHandler|void handler, @
-
*! int|void major, int|void minor,@
-
*! program|void target, object|void placeholder)
-
*!
-
*! Create a PikeCompiler object for a source string.
-
*!
-
*! This function takes a piece of Pike code as a string and
-
*! initializes a compiler object accordingly.
-
*!
-
*! @param source
-
*! Source code to compile.
-
*!
-
*! @param handler
-
*! The optional argument @[handler] is used to specify an alternative
-
*! error handler. If it is not specified the current master object
-
*! at compile time will be used.
-
*!
-
*! @param major
-
*! @param minor
-
*! The optional arguments @[major] and @[minor] are used to tell the
-
*! compiler to attempt to be compatible with Pike @[major].@[minor].
-
*!
-
*! @param target
-
*! @[__empty_program()] program to fill in. The virgin program
-
*! returned by @[__empty_program()] will be modified and returned
-
*! by @[compile()] on success.
-
*!
-
*! @param placeholder
-
*! @[__null_program()] placeholder object to fill in. The object
-
*! will be modified into an instance of the resulting program
-
*! on successfull compile. Note that @[lfun::create()] in the
-
*! program will be called without any arguments.
-
*!
-
*! @note
-
*! Note that @[source] must contain the complete source for a program.
-
*! It is not possible to compile a single expression or statement.
-
*!
-
*! Also note that no preprocessing is performed.
-
*! To preprocess the program you can use @[compile_string()] or
-
*! call the preprocessor manually by calling @[cpp()].
-
*!
-
*! @note
-
*! Note that all references to @[target] and @[placeholder] should
-
*! removed if @[compile()] failes. On failure the @[placeholder]
-
*! object will be destructed.
-
*!
-
*! @seealso
-
*! @[compile_string()], @[compile_file()], @[cpp()], @[master()],
-
*! @[CompilationHandler]
-
*/
-
static void f_compilation_create(INT32 args)
-
{
-
struct pike_string *aprog = NULL;
-
struct object *ahandler = NULL;/* error handler */
-
int amajor = -1;
-
int aminor = -1;
-
struct program *atarget = NULL;
-
struct object *aplaceholder = NULL;
-
int dependants_ok = 1;
-
struct compilation *c = THIS_COMPILATION;
-
-
if (c->flags & COMPILER_BUSY) {
-
Pike_error("PikeCompiler object is in use.\n");
-
}
-
-
STACK_LEVEL_START(args);
-
-
get_all_args("create", args, ".%W%O%d%d%P%O",
-
&aprog, &ahandler,
-
&amajor, &aminor,
-
&atarget, &aplaceholder);
-
-
if (args == 3) {
-
SIMPLE_BAD_ARG_ERROR("create", 4, "int");
-
}
-
-
check_c_stack(65536);
-
-
CDFPRINTF((stderr, "th(%ld) %p compilation create() enter, placeholder=%p\n",
-
(long) th_self(), atarget, aplaceholder));
-
-
debug_malloc_touch(c);
-
-
verify_supporters();
-
-
c->flags &= ~COMPILER_DONE;
-
-
if (c->p) free_program(c->p);
-
c->p = NULL;
-
-
if (c->prog) free_string(c->prog);
-
if ((c->prog=aprog)) add_ref(aprog);
-
-
if (c->handler) free_object(c->handler);
-
if ((c->handler=ahandler)) add_ref(ahandler);
-
-
if (c->target) free_program(c->target);
-
if ((c->target=atarget)) add_ref(atarget);
-
-
if (c->placeholder) free_object(c->placeholder);
-
if ((c->placeholder=aplaceholder)) add_ref(aplaceholder);
-
-
c->major = amajor?amajor:-1;
-
c->minor = aminor?aminor:-1;
-
-
STACK_LEVEL_DONE(args);
-
pop_n_elems(args);
-
-
push_int(0);
-
}
-
-
/*! @decl program compile()
-
*!
-
*! Compile the current source into a program.
-
*!
-
*! This function compiles the current Pike source code
-
*! into a clonable program.
-
*!
-
*! @seealso
-
*! @[compile_string()], @[compile_file()], @[cpp()], @[master()],
-
*! @[CompilationHandler], @[create()]
-
*/
-
static void f_compilation_compile(INT32 args)
-
{
-
int delay, dependants_ok = 1;
-
struct program *ret;
-
#ifdef PIKE_DEBUG
-
ONERROR tmp;
-
#endif
-
struct compilation *c = THIS_COMPILATION;
-
-
if (c->flags & COMPILER_BUSY) {
-
Pike_error("PikeCompiler in use.\n");
-
}
-
-
get_all_args("compile", args, "");
-
-
check_c_stack(65536);
-
-
CDFPRINTF((stderr, "th(%ld) %p f_compilation_compile() enter, "
-
"placeholder=%p\n", (long) th_self(), c->target, c->placeholder));
-
-
debug_malloc_touch(c);
-
-
verify_supporters();
-
-
if (c->flags & COMPILER_DONE) {
-
/* Already compiled. */
-
pop_n_elems(args);
-
if (c->p) ref_push_program(c->p);
-
else push_int(0);
-
return;
-
}
-
-
if (!c->prog) {
-
/* No program text. */
-
low_start_new_program(c->target, 1, NULL, 0, NULL);
-
c->p = end_program();
-
c->flags |= COMPILER_DONE;
-
pop_n_elems(args);
-
ref_push_program(c->p);
-
return;
-
}
-
-
#ifdef PIKE_DEBUG
-
SET_ONERROR(tmp, fatal_on_error,"Compiler exited with longjump!\n");
-
#endif
-
-
c->flags |= COMPILER_BUSY;
-
-
low_init_threads_disable();
-
c->saved_threads_disabled = threads_disabled;
-
-
init_supporter(& c->supporter,
-
(supporter_callback *) call_delayed_pass2,
-
(void *)c);
-
-
delay=run_pass1(c);
-
dependants_ok = call_dependants(& c->supporter, !!c->p );
-
#ifdef PIKE_DEBUG
-
/* FIXME */
-
UNSET_ONERROR(tmp);
-
#endif
-
-
if(delay)
-
{
-
CDFPRINTF((stderr, "th(%ld) %p f_compilation_compile() finish later, "
-
"placeholder=%p.\n",
-
(long) th_self(), c->target, c->placeholder));
-
/* finish later */
-
verify_supporters();
-
/* We're hanging in the supporter. */
-
ret = debug_malloc_pass(c->p);
-
}else{
-
CDFPRINTF((stderr, "th(%ld) %p f_compilation_compile() finish now.\n",
-
(long) th_self(), c->target));
-
/* finish now */
-
run_pass2(c);
-
debug_malloc_touch(c);
-
run_cleanup(c,0);
-
-
ret = debug_malloc_pass(c->p);
-
-
debug_malloc_touch(c);
-
-
if (!dependants_ok) {
-
CDFPRINTF((stderr, "th(%ld) %p f_compilation_compile() reporting failure "
-
"since a dependant failed.\n",
-
(long) th_self(), c->target));
-
throw_error_object(fast_clone_object(compilation_error_program), 0, 0, 0,
-
"Compilation failed.\n");
-
}
-
if(!ret) {
-
CDFPRINTF((stderr, "th(%ld) %p f_compilation_compile() failed.\n",
-
(long) th_self(), c->target));
-
throw_error_object(fast_clone_object(compilation_error_program), 0, 0, 0,
-
"Compilation failed.\n");
-
}
-
debug_malloc_touch(ret);
-
#ifdef PIKE_DEBUG
-
if (a_flag > 2) {
-
dump_program_tables(ret, 0);
-
}
-
#endif /* PIKE_DEBUG */
-
verify_supporters();
-
}
-
pop_n_elems(args);
-
if (ret)
-
ref_push_program(ret);
-
else
-
push_int(0);
-
}
-
-
/*! @decl mixed resolv(string identifier, string filename, @
-
*! object handler)
-
*!
-
*! Resolve the symbol @[identifier].
-
*!
-
*! The default implementation calls the corresponding function
-
*! in any active handler, and otherwise falls back to
-
*! @[CompilerEnvironment()->resolv()] in the parent object.
-
*/
-
static void f_compilation_resolv(INT32 args)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct object *handler;
-
int fun = -1;
-
-
if (((handler = c->handler) && handler->prog &&
-
((fun = find_identifier("resolv", handler->prog)) != -1)) ||
-
((handler = c->compat_handler) && handler->prog &&
-
((fun = find_identifier("resolv", handler->prog)) != -1))) {
-
apply_low(handler, fun, args);
-
} else {
-
apply_external(1, CE_RESOLV_FUN_NUM, args);
-
}
-
}
-
-
/*! @decl object get_compilation_handler(int major, int minor)
-
*!
-
*! Get compatibility handler for Pike @[major].@[minor].
-
*!
-
*! @note
-
*! This function is called by @[change_compiler_compatibility()].
-
*/
-
static void f_compilation_get_compilation_handler(INT32 args)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct object *handler;
-
int fun = -1;
-
-
if (((handler = c->handler) && handler->prog &&
-
((fun = find_identifier("get_compilation_handler", handler->prog)) != -1)) ||
-
((handler = c->compat_handler) && handler->prog &&
-
((fun = find_identifier("get_compilation_handler", handler->prog)) != -1))) {
-
apply_low(handler, fun, args);
-
} else {
-
apply_external(1, CE_GET_COMPILATION_HANDLER_FUN_NUM, args);
-
}
-
}
-
-
/*! @decl mapping(string:mixed)|object get_default_module()
-
*!
-
*! Get the default module for the current compatibility level
-
*! (ie typically the value returned by @[predef::all_constants()]).
-
*!
-
*! The default implementation calls the corresponding function
-
*! in the current handler, the current compatibility handler
-
*! or in the parent @[CompilerEnvironment] in that order.
-
*!
-
*! @returns
-
*! @mixed
-
*! @type mapping(string:mixed)|object
-
*! Constant table to use.
-
*!
-
*! @type int(0..0)
-
*! Use the builtin constant table.
-
*! @endmixed
-
*!
-
*! @note
-
*! This function is called by @[change_compiler_compatibility()].
-
*/
-
static void f_compilation_get_default_module(INT32 args)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct object *handler;
-
int fun = -1;
-
-
if (((handler = c->handler) && handler->prog &&
-
((fun = find_identifier("get_default_module", handler->prog)) != -1)) ||
-
((handler = c->compat_handler) && handler->prog &&
-
((fun = find_identifier("get_default_module", handler->prog)) != -1))) {
-
apply_low(handler, fun, args);
-
} else {
-
apply_external(1, CE_GET_DEFAULT_MODULE_FUN_NUM, args);
-
}
-
}
-
-
/*! @decl void change_compiler_compatibility(int major, int minor)
-
*!
-
*! Change compiler to attempt to be compatible with Pike @[major].@[minor].
-
*/
-
static void f_compilation_change_compiler_compatibility(INT32 args)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
int major = -1;
-
int minor = -1;
-
-
STACK_LEVEL_START(args);
-
-
get_all_args("change_compiler_compatibility", args, "%d%d",
-
&major, &minor);
-
-
if ((major == -1) && (minor == -1)) {
-
major = PIKE_MAJOR_VERSION;
-
minor = PIKE_MINOR_VERSION;
-
}
-
-
if ((major == Pike_compiler->compat_major) &&
-
(minor == Pike_compiler->compat_minor)) {
-
/* Optimization: Already at this compat level. */
-
pop_n_elems(args);
-
push_int(0);
-
return;
-
}
-
-
Pike_compiler->compat_major=major;
-
Pike_compiler->compat_minor=minor;
-
-
/* Optimization: The up to date compiler shouldn't need a compat handler. */
-
if((major != PIKE_MAJOR_VERSION) || (minor != PIKE_MINOR_VERSION))
-
{
-
apply_current(PC_GET_COMPILATION_HANDLER_FUN_NUM, args);
-
-
if((TYPEOF(Pike_sp[-1]) == T_OBJECT) && (Pike_sp[-1].u.object->prog))
-
{
-
if (SUBTYPEOF(Pike_sp[-1])) {
-
/* FIXME: */
-
Pike_error("Subtyped compat handlers are not supported yet.\n");
-
}
-
if (c->compat_handler == Pike_sp[-1].u.object) {
-
/* Still at the same compat level. */
-
pop_stack();
-
push_int(0);
-
return;
-
} else {
-
if(c->compat_handler) free_object(c->compat_handler);
-
c->compat_handler = Pike_sp[-1].u.object;
-
dmalloc_touch_svalue(Pike_sp-1);
-
Pike_sp--;
-
}
-
} else {
-
pop_stack();
-
if(c->compat_handler) {
-
free_object(c->compat_handler);
-
c->compat_handler = NULL;
-
} else {
-
/* No change in compat handler. */
-
push_int(0);
-
return;
-
}
-
}
-
} else {
-
pop_n_elems(args);
-
if (c->compat_handler) {
-
free_object(c->compat_handler);
-
c->compat_handler = NULL;
-
} else {
-
/* No change in compat handler. */
-
push_int(0);
-
return;
-
}
-
}
-
-
STACK_LEVEL_CHECK(0);
-
-
Pike_fp->args = 0; /* Clean up the stack frame. */
-
-
apply_current(PC_GET_DEFAULT_MODULE_FUN_NUM, 0);
-
-
if(TYPEOF(Pike_sp[-1]) == T_INT)
-
{
-
pop_stack();
-
ref_push_mapping(get_builtin_constants());
-
}
-
-
STACK_LEVEL_CHECK(1);
-
-
assign_svalue(&c->default_module, Pike_sp-1);
-
-
/* Replace the implicit import of all_constants() with
-
* the new value.
-
*/
-
if(c->num_used_modules)
-
{
-
free_svalue( (struct svalue *)c->used_modules.s.str );
-
((struct svalue *)c->used_modules.s.str)[0]=sp[-1];
-
sp--;
-
dmalloc_touch_svalue(sp);
-
if(Pike_compiler->module_index_cache)
-
{
-
free_mapping(Pike_compiler->module_index_cache);
-
Pike_compiler->module_index_cache=0;
-
}
-
}else{
-
use_module(sp-1);
-
pop_stack();
-
}
-
-
STACK_LEVEL_DONE(0);
-
push_int(0);
-
}
-
-
/*! @decl program handle_inherit(string inh)
-
*!
-
*! Look up an inherit @[inh] in the current program.
-
*/
-
static void f_compilation_handle_inherit(INT32 args)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct object *handler;
-
int fun = -1;
-
-
if (args > 1) pop_n_elems(args-1);
-
-
ref_push_string(c->lex.current_file);
-
if (c->handler && c->handler->prog) {
-
ref_push_object(c->handler);
-
args = 3;
-
}
-
else args = 2;
-
-
if (((handler = c->handler) && handler->prog &&
-
((fun = find_identifier("handle_inherit", handler->prog)) != -1)) ||
-
((handler = c->compat_handler) && handler->prog &&
-
((fun = find_identifier("handle_inherit", handler->prog)) != -1))) {
-
apply_low(handler, fun, args);
-
} else {
-
apply_external(1, CE_HANDLE_INHERIT_FUN_NUM, args);
-
}
-
}
-
-
/*! @decl int(0..1) pop_type_attribute(string attribute, type a, type b)
-
*!
-
*! Type attribute handler.
-
*!
-
*! Called during type checking when @expr{a <= b@} and
-
*! @[a] had the type attribute @[attribute] before the
-
*! comparison.
-
*!
-
*! The default implementation implements the "deprecated"
-
*! attribute.
-
*!
-
*! @returns
-
*! Returns @expr{1@} if the type check should be allowed
-
*! (ie @expr{__attribute__(attribute, a) <= b@}), and
-
*! @expr{0@} (zero) otherwise.
-
*!
-
*! @seealso
-
*! @[push_type_attribute()]
-
*/
-
static void f_compilation_pop_type_attribute(INT32 args)
-
{
-
struct pike_string *attr;
-
struct svalue *a, *b;
-
struct compilation *c = THIS_COMPILATION;
-
struct pike_string *deprecated_string;
-
-
get_all_args("pop_type_attribute", args, "%W%*%*", &attr, &a, &b);
-
-
if (Pike_compiler->compiler_pass == 2) {
-
MAKE_CONST_STRING(deprecated_string, "deprecated");
-
if ((attr == deprecated_string) &&
-
!(c->lex.pragmas & ID_NO_DEPRECATION_WARNINGS)) {
-
push_svalue(a);
-
yytype_report(REPORT_WARNING, NULL, 0, NULL,
-
NULL, 0, NULL,
-
1, "Using deprecated %O value.");
-
}
-
}
-
pop_n_elems(args);
-
push_int(1);
-
}
-
-
/*! @decl int(0..1) push_type_attribute(string attribute, type a, type b)
-
*!
-
*! Type attribute handler.
-
*!
-
*! Called during type checking when @expr{a <= b@} and
-
*! @[b] had the type attribute @[attribute] before the
-
*! comparison.
-
*!
-
*! The default implementation implements the "deprecated"
-
*! attribute.
-
*!
-
*! @returns
-
*! Returns @expr{1@} if the type check should be allowed
-
*! (ie @expr{a <= __attribute__(attribute, b)@}), and
-
*! @expr{0@} (zero) otherwise.
-
*!
-
*! @seealso
-
*! @[pop_type_attribute()]
-
*/
-
static void f_compilation_push_type_attribute(INT32 args)
-
{
-
struct pike_string *attr;
-
struct svalue *a, *b;
-
struct compilation *c = THIS_COMPILATION;
-
struct pike_string *deprecated_string;
-
-
get_all_args("push_type_attribute", args, "%W%*%*", &attr, &a, &b);
-
-
if (Pike_compiler->compiler_pass == 2) {
-
MAKE_CONST_STRING(deprecated_string, "deprecated");
-
if ((attr == deprecated_string) &&
-
!(c->lex.pragmas & ID_NO_DEPRECATION_WARNINGS) &&
-
!((TYPEOF(*a) == PIKE_T_TYPE) && (a->u.type == zero_type_string))) {
-
/* Don't warn about setting deprecated values to zero. */
-
push_svalue(b);
-
yytype_report(REPORT_WARNING, NULL, 0, NULL,
-
NULL, 0, NULL,
-
1, "Using deprecated %O value.");
-
}
-
}
-
pop_n_elems(args);
-
push_int(1);
-
}
-
-
/*! @decl int(0..1) apply_type_attribute(string attribute, @
-
*! type a, type|void b)
-
*!
-
*! Type attribute handler.
-
*!
-
*! @param attribute
-
*! Attribute that @[a] had.
-
*!
-
*! @param a
-
*! Type of the value being called.
-
*!
-
*! @param b
-
*! Type of the first argument in the call, or
-
*! @[UNDEFINED] if no more arguments.
-
*!
-
*! Called during type checking when @[a] has been successfully
-
*! had a partial evaluation with the argument @[b] and
-
*! @[a] had the type attribute @[attribute] before the
-
*! evaluation.
-
*!
-
*! The default implementation implements the "deprecated"
-
*! attribute.
-
*!
-
*! @returns
-
*! Returns @expr{1@} if the type check should be allowed
-
*! (ie @expr{__attribute__(attribute, a)(b)@}) is valid,
-
*! and @expr{0@} (zero) otherwise.
-
*!
-
*! @seealso
-
*! @[pop_type_attribute()], @[push_type_attribute()]
-
*/
-
static void f_compilation_apply_type_attribute(INT32 args)
-
{
-
struct pike_string *attr;
-
struct svalue *a, *b = NULL;
-
struct compilation *c = THIS_COMPILATION;
-
struct pike_string *deprecated_string;
-
-
get_all_args("apply_type_attribute", args, "%W%*.%*", &attr, &a, &b);
-
-
if (Pike_compiler->compiler_pass == 2) {
-
MAKE_CONST_STRING(deprecated_string, "deprecated");
-
if ((attr == deprecated_string) &&
-
!(c->lex.pragmas & ID_NO_DEPRECATION_WARNINGS) &&
-
(!b ||
-
((TYPEOF(*b) == T_INT) && (SUBTYPEOF(*b) == NUMBER_UNDEFINED) &&
-
(!b->u.integer)))) {
-
/* push_svalue(a); */
-
yytype_report(REPORT_WARNING, NULL, 0, NULL,
-
NULL, 0, NULL,
-
0, "Calling a deprecated value.");
-
}
-
}
-
pop_n_elems(args);
-
push_int(1);
-
}
-
-
/*! @decl type(mixed) apply_attribute_constant(string attr, @
-
*! mixed value, @
-
*! type arg_type, @
-
*! void cont_type)
-
*!
-
*! Handle constant arguments to attributed function argument types.
-
*!
-
*! @param attr
-
*! Attribute that @[arg_type] had.
-
*!
-
*! @param value
-
*! Constant value sent as parameter.
-
*!
-
*! @param arg_type
-
*! Declared type of the function argument.
-
*!
-
*! @param cont_type
-
*! Continuation function type after the current argument.
-
*!
-
*! This function is called when a function is called
-
*! with the constant value @[value] and it has been
-
*! successfully matched against @[arg_type],
-
*! and @[arg_type] had the type attribute @[attr].
-
*!
-
*! This function is typically used to perform specialized
-
*! argument checking and to allow for a strengthening
-
*! of the function type based on @[value].
-
*!
-
*! The default implementation implements the @expr{"sprintf_format"@},
-
*! @expr{"sscanf_format"@} and @expr{"sscanf_76_format"@} attributes.
-
*!
-
*! @returns
-
*! Returns a continuation type if it succeeded in strengthening the type.
-
*!
-
*! Returns @tt{UNDEFINED@} otherwise (this is not an error indication).
-
*!
-
*! @seealso
-
*! @[pop_type_attribute()], @[push_type_attribute()]
-
*/
-
static void f_compilation_apply_attribute_constant(INT32 args)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct pike_string *attribute;
-
struct pike_string *test;
-
struct svalue *sval;
-
get_all_args("apply_attribute_constant", args, "%S%*", &attribute, &sval);
-
-
if ((TYPEOF(*sval) == T_INT) && !sval->u.integer) {
-
pop_n_elems(args);
-
push_undefined();
-
return;
-
}
-
-
MAKE_CONST_STRING(test, "sprintf_format");
-
if (attribute == test) {
-
f___handle_sprintf_format(args);
-
return;
-
}
-
MAKE_CONST_STRING(test, "strict_sprintf_format");
-
if (attribute == test) {
-
f___handle_sprintf_format(args);
-
return;
-
}
-
MAKE_CONST_STRING(test, "sscanf_format");
-
if (attribute == test) {
-
f___handle_sscanf_format(args);
-
return;
-
}
-
MAKE_CONST_STRING(test, "sscanf_76_format");
-
if (attribute == test) {
-
f___handle_sscanf_format(args);
-
return;
-
}
-
pop_n_elems(args);
-
push_undefined();
-
}
-
-
static void f_compilation__sprintf(INT32 args)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
struct string_builder buf;
-
init_string_builder_alloc(&buf, 50, 0);
-
string_builder_strcat(&buf, "PikeCompiler(");
-
if (c->prog) {
-
string_builder_strcat(&buf, "\"\", ");
-
} else {
-
string_builder_strcat(&buf, "UNDEFINED, ");
-
}
-
if (c->handler) {
-
ref_push_object(c->handler);
-
string_builder_sprintf(&buf, "%O, ", Pike_sp-1);
-
pop_stack();
-
} else {
-
string_builder_strcat(&buf, "UNDEFINED, ");
-
}
-
string_builder_sprintf(&buf, "%d, %d, %s, %s)",
-
c->major, c->minor,
-
c->target?"target":"UNDEFINED",
-
c->placeholder?"placeholder":"UNDEFINED");
-
pop_n_elems(args);
-
push_string(finish_string_builder(&buf));
-
}
-
-
/* Fake being called via PikeCompiler()->compile()
-
*
-
* This function is used to set up the environment for
-
* compiling C efuns and modules.
-
*
-
* Note: Since this is a stack frame, it will be cleaned up
-
* automatically on error, so no need to use ONERROR().
-
*
-
* Note: Steals a reference from ce.
-
*/
-
static void low_enter_compiler(struct object *ce, int inherit)
-
{
-
struct pike_frame *new_frame = alloc_pike_frame();
-
#ifdef PROFILING
-
new_frame->children_base = Pike_interpreter.accounted_time;
-
new_frame->start_time = get_cpu_time() - Pike_interpreter.unlocked_time;
-
new_frame->ident = PC_COMPILE_FUN_NUM; /* Fake call of compile(). */
-
#endif /* PROFILING */
-
new_frame->next = Pike_fp;
-
new_frame->current_object = ce;
-
/* Note: The compilation environment object hangs on this frame,
-
* so that it will be freed when the frame dies.
-
*/
-
new_frame->current_program = ce->prog;
-
add_ref(new_frame->current_program);
-
new_frame->context = compilation_program->inherits + inherit;
-
new_frame->current_storage = ce->storage + new_frame->context->storage_offset;
-
#ifdef PIKE_DEBUG
-
if (new_frame->context->prog != compilation_program) {
-
Pike_fatal("Invalid inherit for compilation context (%p != %p).\n",
-
new_frame->context->prog, compilation_program);
-
}
-
#endif /* PIKE_DEBUG */
-
new_frame->fun = new_frame->context->identifier_level + PC_COMPILE_FUN_NUM;
-
new_frame->expendible = Pike_sp;
-
new_frame->locals = Pike_sp;
-
new_frame->save_sp = Pike_sp;
-
new_frame->save_mark_sp = Pike_mark_sp;
-
new_frame->mark_sp_base = Pike_mark_sp;
-
new_frame->args = 0;
-
new_frame->num_locals = 0;
-
new_frame->pc = 0;
-
new_frame->return_addr = 0;
-
new_frame->scope = 0;
-
new_frame->save_sp = Pike_sp;
-
Pike_fp = new_frame;
-
}
-
-
PMOD_EXPORT void enter_compiler(struct pike_string *filename,
-
INT_TYPE linenumber)
-
{
-
struct object *ce = parent_clone_object(compilation_program,
-
compilation_environment,
-
CE_PIKE_COMPILER_FUN_NUM, 0);
-
struct compilation *c;
-
-
low_enter_compiler(ce, 0);
-
-
c = THIS_COMPILATION;
-
if (filename) {
-
free_string(c->lex.current_file);
-
copy_shared_string(c->lex.current_file, filename);
-
}
-
if (linenumber) {
-
c->lex.current_line = linenumber;
-
}
-
}
-
-
/* Reverse the effect of enter_compiler().
-
*/
-
PMOD_EXPORT void exit_compiler(void)
-
{
-
#ifdef PIKE_DEBUG
-
if ((Pike_fp->current_program != compilation_program) ||
-
(Pike_fp->fun != PC_COMPILE_FUN_NUM)) {
-
Pike_fatal("exit_compiler(): Frame stack out of whack!\n");
-
}
-
#endif /* PIKE_DEBUG */
-
POP_PIKE_FRAME();
-
}
-
-
/*! @class CompilerState
-
*!
-
*! Keeps the state of a single program/class during compilation.
-
*!
-
*! @note
-
*! Not in use yet!
-
*/
-
-
#define THIS_PROGRAM_STATE ((struct program_state *)(Pike_fp->current_storage))
-
-
static void program_state_event_handler(int UNUSED(event))
-
{
-
#if 0
-
struct program_state *c = THIS_PROGRAM_STATE;
-
switch (event) {
-
case PROG_EVENT_INIT:
-
#define INIT
-
#include "compilation.h"
-
break;
-
case PROG_EVENT_EXIT:
-
#define EXIT
-
#include "compilation.h"
-
break;
-
}
-
#endif /* 0 */
-
}
-
-
/*! @endclass
-
*/
-
-
/*! @endclass
-
*/
-
-
/*! @endclass
-
*/
-
-
/* Strap the compiler by creating the compilation program by hand. */
-
static void compile_compiler(void)
-
{
-
struct program *p = low_allocate_program();
-
struct program *p2 = compilation_program = low_allocate_program();
-
struct object *co;
-
struct inherit *inh;
-
-
p->parent_info_storage = -1;
-
/* p->event_handler = compilation_env_event_handler; */
-
p->flags |= PROGRAM_HAS_C_METHODS;
-
-
#if 0
-
/* ADD_STORAGE(struct compilation_env); */
-
p->alignment_needed = ALIGNOF(struct compilation_env);
-
p->storage_needed = p->xstorage + sizeof(struct compilation_env);
-
#endif /* 0 */
-
-
/* Add the initial inherit, this is needed for clone_object()
-
* to actually call the event handler, and for low_enter_compiler()
-
* to find the storage and context. */
-
p->inherits = inh = xalloc(sizeof(struct inherit));
-
inh->prog = p;
-
inh->inherit_level = 0;
-
inh->identifier_level = 0;
-
inh->parent_identifier = -1;
-
inh->parent_offset = OBJECT_PARENT;
-
inh->identifier_ref_offset = 0;
-
inh->storage_offset = p->xstorage;
-
inh->parent = NULL;
-
inh->name = NULL;
-
p->num_inherits = 1;
-
-
/* Force clone_object() to accept the program...
-
*/
-
p->flags |= PROGRAM_PASS_1_DONE;
-
compilation_environment = clone_object(p, 0);
-
p->flags &= ~PROGRAM_PASS_1_DONE;
-
-
/* Once more, this time for p2...
-
*/
-
-
p2->parent_info_storage = 0;
-
p2->xstorage = sizeof(struct parent_info);
-
p2->event_handler = compilation_event_handler;
-
p2->flags |= PROGRAM_NEEDS_PARENT|PROGRAM_USES_PARENT|PROGRAM_HAS_C_METHODS;
-
-
/* ADD_STORAGE(struct compilation); */
-
p2->alignment_needed = ALIGNOF(struct compilation);
-
p2->storage_needed = p2->xstorage + sizeof(struct compilation);
-
-
p2->inherits = inh = xalloc(sizeof(struct inherit));
-
inh->prog = p2;
-
inh->inherit_level = 0;
-
inh->identifier_level = 0;
-
inh->parent_identifier = CE_PIKE_COMPILER_FUN_NUM;
-
inh->parent_offset = OBJECT_PARENT;
-
inh->identifier_ref_offset = 0;
-
inh->storage_offset = p2->xstorage;
-
inh->parent = NULL;
-
inh->name = NULL;
-
p2->num_inherits = 1;
-
-
p2->flags |= PROGRAM_PASS_1_DONE;
-
co = parent_clone_object(p2, compilation_environment,
-
CE_PIKE_COMPILER_FUN_NUM, 0);
-
p2->flags &= ~PROGRAM_PASS_1_DONE;
-
-
low_enter_compiler(co, 0);
-
-
low_start_new_program(p, 1, NULL, 0, NULL);
-
free_program(p); /* Remove the extra ref we just got... */
-
-
/* NOTE: The order of these identifiers is hard-coded in
-
* the CE_*_FUN_NUM definitions in "pike_compiler.h".
-
*/
-
-
/* NB: Overloaded properly by inherit of Reporter later on. */
-
ADD_FUNCTION("report", f_reporter_report,
-
tFuncV(tName("SeverityLevel", tInt03) tStr tIntPos
-
tStr tStr, tMix, tVoid),0);
-
-
ADD_FUNCTION("compile", f_compilation_env_compile,
-
tFunc(tOr(tStr, tVoid) tOr(tObj, tVoid)
-
tOr(tInt, tVoid) tOr(tInt, tVoid)
-
tOr(tPrg(tObj), tVoid) tOr(tObj, tVoid),
-
tPrg(tObj)), 0);
-
-
ADD_FUNCTION("resolv", f_compilation_env_resolv,
-
tFunc(tStr tStr tObj, tMix), 0);
-
-
low_start_new_program(p2, 1, NULL, 0, NULL);
-
-
/* low_start_new_program() has zapped the inherit we created
-
* for p2 above, so we need to repair the frame pointer.
-
*/
-
Pike_fp->context = p2->inherits;
-
-
/* MAGIC! We're now executing inside the object being compiled,
-
* and have done sufficient stuff to be able to call and use
-
* the normal program building functions.
-
*/
-
-
/* NOTE: The order of these identifiers is hard-coded in
-
* the PC_*_FUN_NUM definitions in "pike_compiler.h".
-
*/
-
-
ADD_FUNCTION("report", f_compilation_report,
-
tFuncV(tName("SeverityLevel", tInt03) tStr tIntPos
-
tStr tStr, tMix, tVoid),0);
-
-
ADD_FUNCTION("compile", f_compilation_compile,
-
tFunc(tNone, tPrg(tObj)), 0);
-
-
ADD_FUNCTION("resolv", f_compilation_resolv,
-
tFunc(tStr tStr tObj, tMix), 0);
-
-
ADD_FUNCTION("create", f_compilation_create,
-
tFunc(tOr(tStr, tVoid) tOr(tObj, tVoid)
-
tOr(tInt, tVoid) tOr(tInt, tVoid)
-
tOr(tPrg(tObj), tVoid) tOr(tObj, tVoid), tVoid),
-
ID_PROTECTED);
-
-
ADD_FUNCTION("get_compilation_handler",
-
f_compilation_get_compilation_handler,
-
tFunc(tInt tInt, tObj), 0);
-
-
ADD_FUNCTION("get_default_module", f_compilation_get_default_module,
-
tFunc(tNone, tOr(tMap(tStr, tMix), tObj)), 0);
-
-
ADD_FUNCTION("change_compiler_compatibility",
-
f_compilation_change_compiler_compatibility,
-
tFunc(tInt tInt, tVoid), 0);
-
-
ADD_FUNCTION("handle_inherit", f_compilation_handle_inherit,
-
tFunc(tStr, tPrg(tObj)), 0);
-
-
ADD_FUNCTION("pop_type_attribute", f_compilation_pop_type_attribute,
-
tFunc(tStr tType(tMix) tType(tMix), tInt01), 0);
-
-
ADD_FUNCTION("push_type_attribute", f_compilation_push_type_attribute,
-
tFunc(tStr tType(tMix) tType(tMix), tInt01), 0);
-
-
ADD_FUNCTION("apply_type_attribute", f_compilation_apply_type_attribute,
-
tFunc(tStr tType(tMix) tOr(tType(tMix), tVoid), tInt01), 0);
-
-
ADD_FUNCTION("apply_attribute_constant",
-
f_compilation_apply_attribute_constant,
-
tFunc(tStr tMix tType(tMix) tType(tFunction),
-
tType(tFunction)), 0);
-
-
ADD_FUNCTION("_sprintf", f_compilation__sprintf,
-
tFunc(tInt tOr(tMap(tStr, tMix), tVoid), tStr), ID_PROTECTED);
-
-
start_new_program();
-
-
ADD_STORAGE(struct program_state);
-
Pike_compiler->new_program->event_handler = program_state_event_handler;
-
Pike_compiler->new_program->flags |=
-
PROGRAM_NEEDS_PARENT|PROGRAM_USES_PARENT|PROGRAM_HAS_C_METHODS;
-
-
/* Alias for report above. */
-
low_define_alias(NULL, NULL, 0, 1, PC_REPORT_FUN_NUM);
-
-
end_class("CompilerState", 0);
-
-
/* Map some of our variables so that the gc can find them. */
-
PIKE_MAP_VARIABLE("prog", OFFSETOF(compilation, prog),
-
tStr, PIKE_T_STRING, ID_HIDDEN);
-
PIKE_MAP_VARIABLE("handler", OFFSETOF(compilation, handler),
-
tObj, PIKE_T_OBJECT, 0);
-
PIKE_MAP_VARIABLE("compat_handler", OFFSETOF(compilation, compat_handler),
-
tObj, PIKE_T_OBJECT, 0);
-
PIKE_MAP_VARIABLE("target", OFFSETOF(compilation, target),
-
tPrg(tObj), PIKE_T_PROGRAM, ID_HIDDEN);
-
PIKE_MAP_VARIABLE("placeholder", OFFSETOF(compilation, placeholder),
-
tObj, PIKE_T_OBJECT, ID_HIDDEN);
-
PIKE_MAP_VARIABLE("p", OFFSETOF(compilation, p),
-
tPrg(tObj), PIKE_T_PROGRAM, ID_HIDDEN);
-
PIKE_MAP_VARIABLE("current_file", OFFSETOF(compilation, lex.current_file),
-
tStr, PIKE_T_STRING, ID_HIDDEN);
-
PIKE_MAP_VARIABLE("default_module", OFFSETOF(compilation, default_module),
-
tOr(tMap(tStr,tMix),tObj), PIKE_T_MIXED, 0);
-
-
/* end_class()/end_program() adds the parent_info storage once more.
-
* Remove the one we added above, so that we don't get it double.
-
*/
-
p2->xstorage = 0;
-
-
end_class("PikeCompiler", 0);
-
/* end_class()/end_program() has zapped the inherit once again,
-
* so we need to repair the frame pointer.
-
*/
-
Pike_fp->context = compilation_program->inherits;
-
-
ADD_FUNCTION("get_compilation_handler",
-
f_compilation_env_get_compilation_handler,
-
tFunc(tInt tInt, tObj), 0);
-
-
ADD_FUNCTION("get_default_module",
-
f_compilation_env_get_default_module,
-
tFunc(tNone, tOr(tMap(tStr, tMix), tObj)), 0);
-
-
ADD_FUNCTION("handle_inherit", f_compilation_env_handle_inherit,
-
tFunc(tStr tStr tOr(tObj, tVoid), tPrg(tObj)), 0);
-
-
/* Reporter */
-
start_new_program();
-
{
-
struct svalue type_value;
-
-
ADD_FUNCTION("report", f_reporter_report,
-
tFuncV(tName("SeverityLevel", tInt03) tStr tIntPos
-
tStr tStr, tMix, tVoid),0);
-
-
/* enum SeverityLevel { NOTICE, WARNING, ERROR, FATAL } */
-
SET_SVAL(type_value, PIKE_T_TYPE, 0, type,
-
CONSTTYPE(tName("SeverityLevel", tInt03)));
-
simple_add_constant("SeverityLevel", &type_value, 0);
-
free_svalue(&type_value);
-
-
add_integer_constant("NOTICE", REPORT_NOTICE, 0);
-
add_integer_constant("WARNING", REPORT_WARNING, 0);
-
add_integer_constant("ERROR", REPORT_ERROR, 0);
-
add_integer_constant("FATAL", REPORT_FATAL, 0);
-
-
reporter_program = end_program();
-
}
-
add_global_program("Reporter", reporter_program);
-
-
low_inherit(reporter_program, NULL, -1, 0, 0, 0);
-
-
compilation_env_program = end_program();
-
-
add_global_program("CompilerEnvironment", compilation_env_program);
-
-
exit_compiler();
-
-
ref_push_object(compilation_environment);
-
low_add_constant("DefaultCompilerEnvironment", Pike_sp-1);
-
pop_stack();
-
}
-
-
struct program *compile(struct pike_string *aprog,
-
struct object *ahandler,/* error handler */
-
int amajor, int aminor,
-
struct program *atarget,
-
struct object *aplaceholder)
-
{
-
int delay, dependants_ok = 1;
-
struct program *ret;
-
#ifdef PIKE_DEBUG
-
ONERROR tmp;
-
#endif
-
struct object *ce;
-
struct compilation *c;
-
-
/* FIXME! */
-
-
Pike_fatal("Old C-level compile() function called!\n");
-
-
CDFPRINTF((stderr, "th(%ld) %p compile() enter, placeholder=%p\n",
-
(long) th_self(), atarget, aplaceholder));
-
-
ce = clone_object(compilation_program, 0);
-
c = (struct compilation *)ce->storage;
-
-
debug_malloc_touch(c);
-
-
verify_supporters();
-
-
c->p = NULL;
-
add_ref(c->prog=aprog);
-
if((c->handler=ahandler)) add_ref(ahandler);
-
c->major=amajor;
-
c->minor=aminor;
-
if((c->target=atarget)) add_ref(atarget);
-
if((c->placeholder=aplaceholder)) add_ref(aplaceholder);
-
SET_SVAL(c->default_module, T_INT, NUMBER_NUMBER, integer, 0);
-
-
if (c->handler)
-
{
-
if (safe_apply_handler ("get_default_module", c->handler, NULL,
-
0, BIT_MAPPING|BIT_OBJECT|BIT_ZERO)) {
-
if(SAFE_IS_ZERO(Pike_sp-1))
-
{
-
pop_stack();
-
ref_push_mapping(get_builtin_constants());
-
}
-
} else {
-
ref_push_mapping(get_builtin_constants());
-
}
-
}else{
-
ref_push_mapping(get_builtin_constants());
-
}
-
free_svalue(& c->default_module);
-
move_svalue (&c->default_module, --Pike_sp);
-
-
#ifdef PIKE_DEBUG
-
SET_ONERROR(tmp, fatal_on_error,"Compiler exited with longjump!\n");
-
#endif
-
-
low_init_threads_disable();
-
c->saved_threads_disabled = threads_disabled;
-
-
init_supporter(& c->supporter,
-
(supporter_callback *) call_delayed_pass2,
-
(void *)c);
-
-
delay=run_pass1(c);
-
dependants_ok = call_dependants(& c->supporter, !!c->p );
-
#ifdef PIKE_DEBUG
-
/* FIXME */
-
UNSET_ONERROR(tmp);
-
#endif
-
-
if(delay)
-
{
-
CDFPRINTF((stderr, "th(%ld) %p compile() finish later, placeholder=%p.\n",
-
(long) th_self(), c->target, c->placeholder));
-
/* finish later */
-
add_ref(c->p);
-
verify_supporters();
-
return c->p; /* freed later */
-
}else{
-
CDFPRINTF((stderr, "th(%ld) %p compile() finish now\n",
-
(long) th_self(), c->target));
-
/* finish now */
-
if(c->p) run_pass2(c);
-
debug_malloc_touch(c);
-
run_cleanup(c,0);
-
-
ret=c->p;
-
/* FIXME: Looks like ret should get an extra ref here, but I'm not
-
* sure. Besides, this function isn't used anymore. /mast */
-
-
debug_malloc_touch(c);
-
free_object(ce);
-
-
if (!dependants_ok) {
-
CDFPRINTF((stderr, "th(%ld) %p compile() reporting failure "
-
"since a dependant failed.\n",
-
(long) th_self(), c->target));
-
if (ret) free_program(ret);
-
throw_error_object(fast_clone_object(compilation_error_program), 0, 0, 0,
-
"Compilation failed.\n");
-
}
-
if(!ret) {
-
CDFPRINTF((stderr, "th(%ld) %p compile() failed.\n",
-
(long) th_self(), c->target));
-
throw_error_object(fast_clone_object(compilation_error_program), 0, 0, 0,
-
"Compilation failed.\n");
-
}
-
debug_malloc_touch(ret);
-
#ifdef PIKE_DEBUG
-
if (a_flag > 2) {
-
dump_program_tables(ret, 0);
-
}
-
#endif /* PIKE_DEBUG */
-
verify_supporters();
-
return ret;
-
}
-
}
-
-
PMOD_EXPORT int pike_add_function2(const char *name, void (*cfun)(INT32),
-
const char *type, unsigned flags,
-
unsigned opt_flags)
-
{
-
int ret;
-
struct pike_string *name_tmp;
-
struct pike_type *type_tmp;
-
union idptr tmp;
-
-
name_tmp=make_shared_string(name);
-
type_tmp=parse_type(type);
-
-
if(cfun)
-
{
-
tmp.c_fun=cfun;
-
ret=define_function(name_tmp,
-
type_tmp,
-
flags,
-
IDENTIFIER_C_FUNCTION,
-
&tmp,
-
opt_flags);
-
}else{
-
ret=define_function(name_tmp,
-
type_tmp,
-
flags,
-
IDENTIFIER_C_FUNCTION,
-
0,
-
opt_flags);
-
}
-
free_string(name_tmp);
-
free_type(type_tmp);
-
return ret;
-
}
-
-
PMOD_EXPORT int quick_add_function(const char *name,
-
int name_length,
-
void (*cfun)(INT32),
-
const char *type,
-
int UNUSED(type_length),
-
unsigned flags,
-
unsigned opt_flags)
-
{
-
int ret;
-
struct pike_string *name_tmp;
-
struct pike_type *type_tmp;
-
union idptr tmp;
-
/* fprintf(stderr,"ADD_FUNC: %s\n",name); */
-
name_tmp = make_shared_binary_string(name, name_length);
-
type_tmp = make_pike_type(type);
-
-
if(cfun)
-
{
-
tmp.c_fun=cfun;
-
ret=define_function(name_tmp,
-
type_tmp,
-
flags,
-
IDENTIFIER_C_FUNCTION,
-
&tmp,
-
opt_flags);
-
}else{
-
ret=define_function(name_tmp,
-
type_tmp,
-
flags,
-
IDENTIFIER_C_FUNCTION,
-
0,
-
opt_flags);
-
}
-
free_string(name_tmp);
-
free_type(type_tmp);
-
return ret;
-
}
-
-
#ifdef PIKE_DEBUG
-
void check_all_programs(void)
-
{
-
struct program *p;
-
for(p=first_program;p;p=p->next)
-
check_program(p);
-
-
#ifdef FIND_FUNCTION_HASHSIZE
-
{
-
unsigned long e;
-
for(e=0;e<FIND_FUNCTION_HASHSIZE;e++)
-
{
-
if(cache[e].name)
-
{
-
check_string(cache[e].name);
-
if(cache[e].id<0 || cache[e].id > current_program_id)
-
Pike_fatal("Error in find_function_cache[%ld].id\n",(long)e);
-
-
if(cache[e].fun < -1 || cache[e].fun > 65536)
-
Pike_fatal("Error in find_function_cache[%ld].fun\n",(long)e);
-
}
-
}
-
}
-
#endif
-
-
}
-
#endif
-
-
#undef THIS
-
#define THIS ((struct pike_trampoline *)(CURRENT_STORAGE))
-
struct program *pike_trampoline_program=0;
-
-
static void apply_trampoline(INT32 UNUSED(args))
-
{
-
Pike_error("Internal error: Trampoline magic failed!\n");
-
}
-
-
static void not_trampoline(INT32 args)
-
{
-
pop_n_elems(args);
-
if (!THIS->frame || !THIS->frame->current_object ||
-
!THIS->frame->current_object->prog) {
-
push_int(1);
-
} else {
-
push_int(0);
-
}
-
}
-
-
static void sprintf_trampoline (INT32 args)
-
{
-
dynamic_buffer save_buf;
-
dynbuf_string str;
-
-
if (!args || TYPEOF(sp[-args]) != T_INT || sp[-args].u.integer != 'O' ||
-
!THIS->frame || !THIS->frame->current_object) {
-
pop_n_elems (args);
-
push_int (0);
-
return;
-
}
-
pop_n_elems (args);
-
-
ref_push_function (THIS->frame->current_object, THIS->func);
-
init_buf(&save_buf);
-
describe_svalue (sp - 1, 0, 0);
-
str = complex_free_buf(&save_buf);
-
pop_stack();
-
push_string (make_shared_binary_string (str.str, str.len));
-
free (str.str);
-
}
-
-
static void init_trampoline(struct object *UNUSED(o))
-
{
-
THIS->frame=0;
-
}
-
-
static void exit_trampoline(struct object *UNUSED(o))
-
{
-
if(THIS->frame)
-
{
-
free_pike_scope(THIS->frame);
-
THIS->frame=0;
-
}
-
}
-
-
static void gc_check_frame(struct pike_frame *f)
-
{
-
if(f->flags & PIKE_FRAME_MALLOCED_LOCALS)
-
{
-
if(f->current_object)
-
debug_gc_check (f->current_object, " as current_object in trampoline frame");
-
if(f->current_program)
-
debug_gc_check (f->current_program, " as current_program in trampoline frame");
-
debug_gc_check_svalues (f->locals, f->num_locals, " in locals of trampoline frame");
-
if(f->scope && !debug_gc_check (f->scope, " as scope frame of trampoline frame"))
-
gc_check_frame(f->scope);
-
}
-
}
-
-
static void gc_check_trampoline(struct object *UNUSED(o))
-
{
-
if (THIS->frame &&
-
!debug_gc_check (THIS->frame, " as trampoline frame"))
-
gc_check_frame(THIS->frame);
-
}
-
-
static void gc_recurse_frame(struct pike_frame *f)
-
{
-
if(f->current_object) gc_recurse_object(f->current_object);
-
if(f->current_program) gc_recurse_program(f->current_program);
-
if(f->flags & PIKE_FRAME_MALLOCED_LOCALS)
-
gc_recurse_svalues(f->locals,f->num_locals);
-
if(f->scope) gc_recurse_frame(f->scope);
-
}
-
-
static void gc_recurse_trampoline(struct object *UNUSED(o))
-
{
-
if (THIS->frame) gc_recurse_frame(THIS->frame);
-
}
-
-
-
/* This placeholder should be used
-
* in the first compiler pass to take the place
-
* of unknown things
-
*/
-
struct program *placeholder_program;
-
struct object *placeholder_object;
-
-
void placeholder_index(INT32 args)
-
{
-
pop_n_elems(args);
-
ref_push_object(Pike_fp->current_object);
-
}
-
-
static void placeholder_sprintf (INT32 args)
-
{
-
struct pike_string *s;
-
-
if (!args || TYPEOF(sp[-args]) != T_INT || sp[-args].u.integer != 'O') {
-
pop_n_elems (args);
-
push_int (0);
-
return;
-
}
-
-
pop_n_elems (args);
-
MAKE_CONST_STRING (s, "__placeholder_object");
-
ref_push_string (s);
-
}
-
-
void init_program(void)
-
{
-
size_t i;
-
struct svalue key;
-
struct svalue val;
-
struct svalue id;
-
init_program_blocks();
-
-
MAKE_CONST_STRING(this_function_string,"this_function");
-
MAKE_CONST_STRING(this_program_string,"this_program");
-
MAKE_CONST_STRING(this_string,"this");
-
MAKE_CONST_STRING(UNDEFINED_string,"UNDEFINED");
-
-
MAKE_CONST_STRING(parser_system_string, "parser");
-
MAKE_CONST_STRING(type_check_system_string, "type_check");
-
-
lfun_ids = allocate_mapping(NUM_LFUNS);
-
lfun_types = allocate_mapping(NUM_LFUNS);
-
for (i=0; i < NELEM(lfun_names); i++) {
-
lfun_strings[i] = make_shared_string(lfun_names[i]);
-
-
SET_SVAL(id, T_INT, NUMBER_NUMBER, integer, i);
-
SET_SVAL(key, T_STRING, 0, string, lfun_strings[i]);
-
mapping_insert(lfun_ids, &key, &id);
-
-
SET_SVAL(val, T_TYPE, 0, type, make_pike_type(raw_lfun_types[i]));
-
mapping_insert(lfun_types, &key, &val);
-
free_type(val.u.type);
-
}
-
-
lfun_getter_type_string = make_pike_type(tFuncV(tNone, tVoid, tMix));
-
lfun_setter_type_string = make_pike_type(tFuncV(tZero, tVoid, tVoid));
-
-
compile_compiler();
-
-
enter_compiler(NULL, 0);
-
-
start_new_program();
-
debug_malloc_touch(Pike_compiler->fake_object);
-
debug_malloc_touch(Pike_compiler->fake_object->storage);
-
ADD_STORAGE(struct pike_trampoline);
-
ADD_FUNCTION("`()",apply_trampoline,tFunction,0);
-
ADD_FUNCTION("`!",not_trampoline,tFunc(tVoid,tInt),0);
-
ADD_FUNCTION("_sprintf", sprintf_trampoline,
-
tFunc(tInt tOr(tMapping,tVoid),tStr), 0);
-
set_init_callback(init_trampoline);
-
set_exit_callback(exit_trampoline);
-
set_gc_check_callback(gc_check_trampoline);
-
set_gc_recurse_callback(gc_recurse_trampoline);
-
debug_malloc_touch(Pike_compiler->fake_object);
-
debug_malloc_touch(Pike_compiler->fake_object->storage);
-
pike_trampoline_program=end_program();
-
-
/*! @decl constant __null_program
-
*!
-
*! Program used internally by the compiler to create objects
-
*! that are later modified into instances of the compiled program
-
*! by the compiler.
-
*!
-
*! @seealso
-
*! @[__placeholder_object]
-
*/
-
{
-
struct svalue s;
-
debug_start_new_program(0, "__null_program");
-
null_program=end_program();
-
SET_SVAL(s, T_PROGRAM, 0, program, null_program);
-
low_add_constant("__null_program",&s);
-
debug_malloc_touch(null_program);
-
}
-
-
/*! @decl constant __placeholder_object
-
*!
-
*! Object used internally by the compiler.
-
*!
-
*! @seealso
-
*! @[__null_program]
-
*/
-
{
-
struct svalue s;
-
start_new_program();
-
ADD_FUNCTION("`()", placeholder_index, tFuncV(tNone,tMix,tObj), 0);
-
ADD_FUNCTION("`[]", placeholder_index, tFunc(tMix,tObj), 0);
-
ADD_FUNCTION("_sprintf", placeholder_sprintf,
-
tFunc(tInt tOr(tMapping,tVoid),tStr), 0);
-
placeholder_program=end_program();
-
placeholder_object=fast_clone_object(placeholder_program);
-
-
SET_SVAL(s, T_OBJECT, 0, object, placeholder_object);
-
low_add_constant("__placeholder_object",&s);
-
debug_malloc_touch(placeholder_object);
-
}
-
-
exit_compiler();
-
}
-
-
void cleanup_program(void)
-
{
-
size_t e;
-
-
free_type(lfun_setter_type_string);
-
free_type(lfun_getter_type_string);
-
free_mapping(lfun_types);
-
free_mapping(lfun_ids);
-
for (e=0; e < NELEM(lfun_names); e++) {
-
free_string(lfun_strings[e]);
-
}
-
#ifdef FIND_FUNCTION_HASHSIZE
-
for(e=0;e<FIND_FUNCTION_HASHSIZE;e++)
-
{
-
if(cache[e].name)
-
{
-
free_string(cache[e].name);
-
cache[e].name=0;
-
}
-
}
-
#endif
-
-
#ifdef DO_PIKE_CLEANUP
-
if(pike_trampoline_program)
-
{
-
free_program(pike_trampoline_program);
-
pike_trampoline_program=0;
-
}
-
-
if(null_program)
-
{
-
free_program(null_program);
-
null_program=0;
-
}
-
-
if(placeholder_object)
-
{
-
free_object(placeholder_object);
-
placeholder_object=0;
-
}
-
-
if(placeholder_program)
-
{
-
free_program(placeholder_program);
-
placeholder_program=0;
-
}
-
#endif
-
-
if (compilation_program) {
-
free_program(compilation_program);
-
compilation_program = 0;
-
}
-
if (compilation_environment) {
-
free_object(compilation_environment);
-
compilation_environment = 0;
-
}
-
if (compilation_env_program) {
-
free_program(compilation_env_program);
-
compilation_env_program = 0;
-
}
-
if (reporter_program) {
-
free_program(reporter_program);
-
reporter_program = 0;
-
}
-
}
-
-
-
PMOD_EXPORT void visit_program (struct program *p, int action)
-
{
-
switch (action) {
-
#ifdef PIKE_DEBUG
-
default:
-
Pike_fatal ("Unknown visit action %d.\n", action);
-
case VISIT_NORMAL:
-
case VISIT_COMPLEX_ONLY:
-
break;
-
#endif
-
case VISIT_COUNT_BYTES:
-
mc_counted_bytes += p->total_size;
-
break;
-
}
-
-
if (!(p->flags & PROGRAM_AVOID_CHECK)) {
-
int e;
-
struct program_constant *consts = p->constants;
-
struct inherit *inh = p->inherits;
-
-
for (e = p->num_constants - 1; e >= 0; e--)
-
visit_svalue (&consts[e].sval, REF_TYPE_NORMAL);
-
-
for (e = p->num_inherits - 1; e >= 0; e--) {
-
if (inh[e].parent)
-
visit_object_ref (inh[e].parent, REF_TYPE_NORMAL);
-
-
if (e && inh[e].prog)
-
visit_program_ref (inh[e].prog, REF_TYPE_NORMAL);
-
}
-
-
if (!(action & VISIT_COMPLEX_ONLY)) {
-
struct identifier *ids = p->identifiers;
-
struct pike_string **strs = p->strings;
-
-
for (e = p->num_inherits - 1; e >= 0; e--) {
-
if (inh[e].name)
-
visit_string_ref (inh[e].name, REF_TYPE_NORMAL);
-
}
-
-
for (e = p->num_identifiers - 1; e >= 0; e--) {
-
struct identifier *id = ids + e;
-
visit_string_ref (id->name, REF_TYPE_NORMAL);
-
visit_type_ref (id->type, REF_TYPE_NORMAL);
-
}
-
-
for (e = p->num_strings - 1; e >= 0; e--)
-
visit_string_ref (strs[e], REF_TYPE_NORMAL);
-
}
-
-
/* Strong ref follows. It must be last. */
-
if (p->parent)
-
visit_program_ref (p->parent, REF_TYPE_STRONG);
-
}
-
}
-
-
static void gc_check_program(struct program *p);
-
-
void gc_mark_program_as_referenced(struct program *p)
-
{
-
debug_malloc_touch(p);
-
-
if (p->flags & PROGRAM_AVOID_CHECK) {
-
/* Program is in an inconsistent state.
-
* don't look closer at it.
-
*/
-
debug_malloc_touch(p);
-
-
if (gc_mark(p, T_PROGRAM)) {
-
if (p == gc_mark_program_pos)
-
gc_mark_program_pos = p->next;
-
if (p == gc_internal_program)
-
gc_internal_program = p->next;
-
else {
-
DOUBLEUNLINK(first_program, p);
-
DOUBLELINK(first_program, p); /* Linked in first. */
-
}
-
}
-
-
return;
-
}
-
-
if(gc_mark(p, T_PROGRAM))
-
GC_ENTER (p, T_PROGRAM) {
-
int e;
-
-
if (p == gc_mark_program_pos)
-
gc_mark_program_pos = p->next;
-
if (p == gc_internal_program)
-
gc_internal_program = p->next;
-
else {
-
DOUBLEUNLINK(first_program, p);
-
DOUBLELINK(first_program, p); /* Linked in first. */
-
}
-
-
if(p->parent)
-
gc_mark_program_as_referenced(p->parent);
-
-
for(e = p->num_constants - 1; e >= 0; e--)
-
gc_mark_svalues(& p->constants[e].sval, 1);
-
-
for(e = p->num_inherits - 1; e >= 0; e--)
-
{
-
if(p->inherits[e].parent)
-
gc_mark_object_as_referenced(p->inherits[e].parent);
-
-
if(e && p->inherits[e].prog)
-
gc_mark_program_as_referenced(p->inherits[e].prog);
-
}
-
-
#if defined (PIKE_DEBUG) || defined (DO_PIKE_CLEANUP)
-
for (e = p->num_identifiers - 1; e >= 0; e--)
-
gc_mark_type_as_referenced (p->identifiers[e].type);
-
#endif
-
-
} GC_LEAVE;
-
}
-
-
void real_gc_cycle_check_program(struct program *p, int weak)
-
{
-
GC_CYCLE_ENTER(p, T_PROGRAM, weak) {
-
int e;
-
-
if (!(p->flags & PROGRAM_AVOID_CHECK))
-
{
-
for(e = p->num_constants - 1; e >= 0; e--)
-
gc_cycle_check_svalues(& p->constants[e].sval, 1);
-
-
for(e = p->num_inherits - 1; e >= 0; e--)
-
{
-
if(p->inherits[e].parent)
-
gc_cycle_check_object(p->inherits[e].parent, 0);
-
-
if(e && p->inherits[e].prog)
-
gc_cycle_check_program(p->inherits[e].prog, 0);
-
}
-
-
/* Strong ref follows. It must be last. */
-
if(p->parent)
-
gc_cycle_check_program(p->parent, 0);
-
}
-
} GC_CYCLE_LEAVE;
-
}
-
-
static void gc_check_program(struct program *p)
-
{
-
int e;
-
-
debug_malloc_touch(p);
-
-
if (p->flags & PROGRAM_AVOID_CHECK) {
-
/* Program is in an inconsistent state.
-
* don't look closer at it.
-
*/
-
debug_malloc_touch(p);
-
return;
-
}
-
-
GC_ENTER (p, T_PROGRAM) {
-
if(p->parent)
-
debug_gc_check (p->parent, " as parent program of a program");
-
-
for(e = p->num_constants - 1; e >= 0; e--) {
-
debug_gc_check_svalues (&p->constants[e].sval, 1, " as program constant");
-
}
-
-
for(e = p->num_inherits - 1; e >= 0; e--)
-
{
-
if(p->inherits[e].parent)
-
{
-
debug_gc_check (p->inherits[e].parent,
-
" as inherited parent object of a program");
-
}
-
-
#ifdef PIKE_DEBUG
-
if (Pike_in_gc == GC_PASS_LOCATE && p->inherits[e].name)
-
debug_gc_check (p->inherits[e].name, " as inherit name");
-
#endif
-
-
if(e && p->inherits[e].prog)
-
debug_gc_check (p->inherits[e].prog, " as inherited program of a program");
-
}
-
-
#if defined (PIKE_DEBUG) || defined (DO_PIKE_CLEANUP)
-
if (gc_keep_markers || Pike_in_gc == GC_PASS_LOCATE)
-
{
-
for(e = p->num_strings - 1; e >= 0; e--)
-
debug_gc_check (p->strings[e], " in the string storage of a program");
-
for(e = p->num_identifiers - 1; e >= 0; e--)
-
debug_gc_check (p->identifiers[e].name,
-
" as identifier name in a program");
-
}
-
-
for(e = p->num_identifiers - 1; e >= 0; e--)
-
debug_gc_check (p->identifiers[e].type,
-
" as identifier type in a program");
-
#endif
-
-
} GC_LEAVE;
-
}
-
-
unsigned gc_touch_all_programs(void)
-
{
-
unsigned n = 0;
-
struct program *p;
-
if (first_program && first_program->prev)
-
Pike_fatal("Error in program link list.\n");
-
for (p = first_program; p; p = p->next) {
-
debug_gc_touch(p);
-
n++;
-
if (p->next && p->next->prev != p)
-
Pike_fatal("Error in program link list.\n");
-
}
-
return n;
-
}
-
-
void gc_check_all_programs(void)
-
{
-
struct program *p;
-
for(p=first_program;p;p=p->next) gc_check_program(p);
-
}
-
-
void gc_mark_all_programs(void)
-
{
-
gc_mark_program_pos = gc_internal_program;
-
while (gc_mark_program_pos) {
-
struct program *p = gc_mark_program_pos;
-
gc_mark_program_pos = p->next;
-
if(gc_is_referenced(p)) {
-
gc_mark_program_as_referenced(debug_malloc_pass(p));
-
}
-
}
-
}
-
-
void gc_cycle_check_all_programs(void)
-
{
-
struct program *p;
-
for (p = gc_internal_program; p; p = p->next) {
-
real_gc_cycle_check_program(p, 0);
-
gc_cycle_run_queue();
-
}
-
}
-
-
void gc_zap_ext_weak_refs_in_programs(void)
-
{
-
gc_mark_program_pos = first_program;
-
while (gc_mark_program_pos != gc_internal_program && gc_ext_weak_refs) {
-
struct program *p = gc_mark_program_pos;
-
gc_mark_program_pos = p->next;
-
gc_mark_program_as_referenced(p);
-
}
-
gc_mark_discard_queue();
-
}
-
-
size_t gc_free_all_unreferenced_programs(void)
-
{
-
struct program *p,*next;
-
size_t unreferenced = 0;
-
#ifdef PIKE_DEBUG
-
int first = 1;
-
#endif
-
-
for(p=gc_internal_program;p;p=next)
-
{
-
debug_malloc_touch(p);
-
-
if(gc_do_free(p))
-
{
-
/* Got an extra ref from gc_cycle_pop_object(). */
-
int e;
-
if(p->parent)
-
{
-
free_program(p->parent);
-
p->parent=0;
-
}
-
for(e=0;e<p->num_constants;e++)
-
{
-
free_svalue(& p->constants[e].sval);
-
SET_SVAL(p->constants[e].sval, T_INT, NUMBER_NUMBER, integer, 0);
-
}
-
-
for(e=0;e<p->num_inherits;e++)
-
{
-
if(p->inherits[e].parent)
-
{
-
free_object(p->inherits[e].parent);
-
p->inherits[e].parent=0;
-
}
-
if(e && p->inherits[e].prog)
-
{
-
free_program(p->inherits[e].prog);
-
p->inherits[e].prog=0;
-
}
-
}
-
-
gc_free_extra_ref(p);
-
SET_NEXT_AND_FREE(p, free_program);
-
#ifdef PIKE_DEBUG
-
if (first) gc_internal_program = next;
-
#endif
-
}else{
-
next=p->next;
-
#ifdef PIKE_DEBUG
-
first = 0;
-
#endif
-
}
-
unreferenced++;
-
}
-
-
#ifdef PIKE_DEBUG
-
if (gc_debug)
-
for (p = first_program; p != gc_internal_program; p = p->next) {
-
int e,tmp=0;
-
if (!p)
-
Pike_fatal("gc_internal_program was bogus.\n");
-
for(e=0;e<p->num_constants;e++)
-
{
-
if(TYPEOF(p->constants[e].sval) == T_PROGRAM &&
-
p->constants[e].sval.u.program == p)
-
tmp++;
-
}
-
if(tmp >= p->refs)
-
gc_fatal(p, 1 ,"garbage collector failed to free program!!!\n");
-
}
-
#endif
-
-
return unreferenced;
-
}
-
-
-
void push_compiler_frame(int lexical_scope)
-
{
-
struct compiler_frame *f;
-
f=ALLOC_STRUCT(compiler_frame);
-
f->previous=Pike_compiler->compiler_frame;
-
f->lexical_scope=lexical_scope;
-
f->current_type=0;
-
f->current_return_type=0;
-
-
f->current_number_of_locals=0;
-
f->max_number_of_locals=0;
-
f->min_number_of_locals=0;
-
f->last_block_level=-1;
-
-
f->current_function_number=-2; /* no function */
-
f->recur_label=-1;
-
f->is_inline=0;
-
f->num_args=-1;
-
f->opt_flags = OPT_SIDE_EFFECT|OPT_EXTERNAL_DEPEND; /* FIXME: Should be 0. */
-
Pike_compiler->compiler_frame=f;
-
}
-
-
void low_pop_local_variables(int level)
-
{
-
struct compilation *c = THIS_COMPILATION;
-
while(Pike_compiler->compiler_frame->current_number_of_locals > level)
-
{
-
int e;
-
e=--(Pike_compiler->compiler_frame->current_number_of_locals);
-
if ((Pike_compiler->compiler_pass == 2) &&
-
!(Pike_compiler->compiler_frame->variable[e].flags &
-
LOCAL_VAR_IS_USED)) {
-
ref_push_string(Pike_compiler->compiler_frame->variable[e].name);
-
low_yyreport(REPORT_WARNING,
-
Pike_compiler->compiler_frame->variable[e].file,
-
Pike_compiler->compiler_frame->variable[e].line,
-
parser_system_string,
-
1, "Unused local variable %s.");
-
}
-
free_string(Pike_compiler->compiler_frame->variable[e].name);
-
free_type(Pike_compiler->compiler_frame->variable[e].type);
-
if(Pike_compiler->compiler_frame->variable[e].def)
-
free_node(Pike_compiler->compiler_frame->variable[e].def);
-
-
free_string(Pike_compiler->compiler_frame->variable[e].file);
-
}
-
}
-
-
void pop_local_variables(int level)
-
{
-
#if 1
-
struct compilation *c = THIS_COMPILATION;
-
/* We need to save the variables Kuppo (but not their names) */
-
if(level < Pike_compiler->compiler_frame->min_number_of_locals)
-
{
-
/* FIXME: Consider using flags to indicate whether a local variable
-
* actually is used from a nested scope. */
-
for(;level<Pike_compiler->compiler_frame->min_number_of_locals;level++)
-
{
-
if ((Pike_compiler->compiler_pass == 2) &&
-
!(Pike_compiler->compiler_frame->variable[level].flags &
-
LOCAL_VAR_IS_USED)) {
-
ref_push_string(Pike_compiler->compiler_frame->variable[level].name);
-
low_yyreport(REPORT_WARNING,
-
Pike_compiler->compiler_frame->variable[level].file,
-
Pike_compiler->compiler_frame->variable[level].line,
-
parser_system_string,
-
1, "Unused local variable %s.");
-
/* Make sure we only warn once... */
-
Pike_compiler->compiler_frame->variable[level].flags |=
-
LOCAL_VAR_IS_USED;
-
}
-
free_string(Pike_compiler->compiler_frame->variable[level].name);
-
copy_shared_string(Pike_compiler->compiler_frame->variable[level].name,
-
empty_pike_string);
-
/* FIXME: Do we need to keep the filenames? */
-
}
-
}
-
#endif
-
low_pop_local_variables(level);
-
}
-
-
-
void pop_compiler_frame(void)
-
{
-
struct compiler_frame *f;
-
-
f=Pike_compiler->compiler_frame;
-
#ifdef PIKE_DEBUG
-
if(!f)
-
Pike_fatal("Popping out of compiler frames\n");
-
#endif
-
-
low_pop_local_variables(0);
-
if(f->current_type)
-
free_type(f->current_type);
-
-
if(f->current_return_type)
-
free_type(f->current_return_type);
-
-
Pike_compiler->compiler_frame=f->previous;
-
dmfree((char *)f);
-
}
-
-
-
#define GET_STORAGE_CACHE_SIZE 1024
-
static struct get_storage_cache
-
{
-
INT32 oid, pid;
-
ptrdiff_t offset;
-
} get_storage_cache[GET_STORAGE_CACHE_SIZE];
-
-
PMOD_EXPORT ptrdiff_t low_get_storage(struct program *o, struct program *p)
-
{
-
INT32 oid, pid;
-
ptrdiff_t offset;
-
unsigned INT32 hval;
-
-
if(!o) return -1;
-
oid=o->id;
-
pid=p->id;
-
hval=oid*9248339 + pid;
-
hval%=GET_STORAGE_CACHE_SIZE;
-
#ifdef PIKE_DEBUG
-
if(hval>GET_STORAGE_CACHE_SIZE)
-
Pike_fatal("hval>GET_STORAGE_CACHE_SIZE\n");
-
#endif
-
if(get_storage_cache[hval].oid == oid &&
-
get_storage_cache[hval].pid == pid)
-
{
-
offset=get_storage_cache[hval].offset;
-
}else{
-
INT32 e;
-
offset=-1;
-
for(e=0;e<o->num_inherits;e++)
-
{
-
if(o->inherits[e].prog==p)
-
{
-
offset=o->inherits[e].storage_offset;
-
break;
-
}
-
}
-
-
get_storage_cache[hval].oid=oid;
-
get_storage_cache[hval].pid=pid;
-
get_storage_cache[hval].offset=offset;
-
}
-
-
return offset;
-
}
-
-
PMOD_EXPORT char *get_storage(struct object *o, struct program *p)
-
{
-
ptrdiff_t offset;
-
-
#ifdef _REENTRANT
-
if(d_flag) CHECK_INTERPRETER_LOCK();
-
#endif
-
-
offset= low_get_storage(o->prog, p);
-
if(offset == -1) return 0;
-
return o->storage + offset;
-
}
-
-
struct program *low_program_from_function(struct object *o, INT32 i)
-
{
-
struct svalue *f;
-
struct program *p;
-
struct identifier *id;
-
while(1) {
-
struct external_variable_context loc;
-
p = o->prog;
-
-
if(!p) return 0;
-
-
id = ID_FROM_INT(p, i);
-
if(!IDENTIFIER_IS_ALIAS(id->identifier_flags)) break;
-
-
loc.o = o;
-
loc.inherit = INHERIT_FROM_INT(p, i);
-
loc.parent_identifier = i;
-
find_external_context(&loc, id->func.ext_ref.depth);
-
i = id->func.ext_ref.id + loc.inherit->identifier_level;
-
o = loc.o;
-
}
-
if(!IDENTIFIER_IS_CONSTANT(id->identifier_flags)) return 0;
-
if(id->func.const_info.offset==-1) return 0;
-
f = &PROG_FROM_INT(p,i)->constants[id->func.const_info.offset].sval;
-
if(TYPEOF(*f) != T_PROGRAM) return 0;
-
return f->u.program;
-
}
-
-
PMOD_EXPORT struct program *program_from_function(const struct svalue *f)
-
{
-
if(TYPEOF(*f) != T_FUNCTION) return 0;
-
if(SUBTYPEOF(*f) == FUNCTION_BUILTIN) return 0;
-
-
return low_program_from_function(f->u.object, SUBTYPEOF(*f));
-
}
-
-
/* NOTE: Does not add references to the return value! */
-
PMOD_EXPORT struct program *low_program_from_svalue(const struct svalue *s,
-
struct object **parent_obj,
-
int *parent_id)
-
{
-
switch(TYPEOF(*s))
-
{
-
case T_OBJECT:
-
{
-
struct program *p = s->u.object->prog;
-
#if 0
-
int call_fun;
-
#endif
-
-
if (!p) return 0;
-
-
#if 0
-
p = p->inherits[SUBTYPEOF(*s)].prog;
-
if ((call_fun = FIND_LFUN(p, LFUN_CALL)) >= 0) {
-
/* Get the program from the return type. */
-
struct identifier *id = ID_FROM_INT(p, call_fun);
-
/* FIXME: do it. */
-
return 0;
-
}
-
#endif
-
push_svalue(s);
-
o_cast(program_type_string, T_PROGRAM);
-
p = low_program_from_svalue(Pike_sp-1, parent_obj, parent_id);
-
pop_stack();
-
return p; /* We trust that there is a reference somewhere... */
-
}
-
-
case T_FUNCTION:
-
if (SUBTYPEOF(*s) == FUNCTION_BUILTIN) return 0;
-
return low_program_from_function(*parent_obj = s->u.object,
-
*parent_id = SUBTYPEOF(*s));
-
-
case T_PROGRAM:
-
return s->u.program;
-
default:
-
return 0;
-
}
-
}
-
-
/* NOTE: Does not add references to the return value! */
-
PMOD_EXPORT struct program *program_from_svalue(const struct svalue *s)
-
{
-
struct object *parent_obj = NULL;
-
int parent_id = -1;
-
return low_program_from_svalue(s, &parent_obj, &parent_id);
-
}
-
-
#define FIND_CHILD_HASHSIZE 5003
-
struct find_child_cache_s
-
{
-
INT32 pid,cid,id;
-
};
-
-
#if 0
-
static struct find_child_cache_s find_child_cache[FIND_CHILD_HASHSIZE];
-
-
int find_child(struct program *parent, struct program *child)
-
{
-
unsigned INT32 h=(parent->id * 9248339 + child->id);
-
h= h % FIND_CHILD_HASHSIZE;
-
#ifdef PIKE_DEBUG
-
if(h>=FIND_CHILD_HASHSIZE)
-
Pike_fatal("find_child failed to hash within boundaries.\n");
-
#endif
-
if(find_child_cache[h].pid == parent->id &&
-
find_child_cache[h].cid == child->id)
-
{
-
return find_child_cache[h].id;
-
}else{
-
INT32 i;
-
for(i=0;i<parent->num_identifier_references;i++)
-
{
-
if(low_program_from_function(parent, i)==child)
-
{
-
find_child_cache[h].pid=parent->id;
-
find_child_cache[h].cid=child->id;
-
find_child_cache[h].id=i;
-
return i;
-
}
-
}
-
}
-
return -1;
-
}
-
#endif /* 0 */
-
-
-
-
/* returns 1 if a implements b */
-
static int low_implements(struct program *a, struct program *b)
-
{
-
int e;
-
struct pike_string *s=findstring("__INIT");
-
for(e=0;e<b->num_identifier_references;e++)
-
{
-
struct identifier *bid;
-
int i;
-
if (b->identifier_references[e].id_flags & (ID_PROTECTED|ID_HIDDEN|ID_VARIANT))
-
continue; /* Skip protected & hidden */
-
bid = ID_FROM_INT(b,e);
-
if(s == bid->name) continue; /* Skip __INIT */
-
i = find_shared_string_identifier(bid->name,a);
-
if (i == -1) {
-
if (b->identifier_references[e].id_flags & (ID_OPTIONAL))
-
continue; /* It's ok... */
-
#if 0
-
fprintf(stderr, "Missing identifier \"%s\"\n", bid->name->str);
-
#endif /* 0 */
-
return 0;
-
}
-
-
if (!pike_types_le(bid->type, ID_FROM_INT(a, i)->type)) {
-
if(!match_types(ID_FROM_INT(a,i)->type, bid->type)) {
-
#if 0
-
fprintf(stderr, "Identifier \"%s\" is incompatible.\n",
-
bid->name->str);
-
#endif /* 0 */
-
return 0;
-
} else {
-
#if 0
-
fprintf(stderr, "Identifier \"%s\" is not strictly compatible.\n",
-
bid->name->str);
-
#endif /* 0 */
-
}
-
}
-
}
-
return 1;
-
}
-
-
#define IMPLEMENTS_CACHE_SIZE 4711
-
struct implements_cache_s { INT32 aid, bid, ret; };
-
static struct implements_cache_s implements_cache[IMPLEMENTS_CACHE_SIZE];
-
-
/* returns 1 if a implements b, but faster */
-
PMOD_EXPORT int implements(struct program *a, struct program *b)
-
{
-
unsigned long hval;
-
if(!a || !b) return -1;
-
if(a==b) return 1;
-
-
hval = a->id*9248339 + b->id;
-
hval %= IMPLEMENTS_CACHE_SIZE;
-
#ifdef PIKE_DEBUG
-
if(hval >= IMPLEMENTS_CACHE_SIZE)
-
Pike_fatal("Implements_cache failed!\n");
-
#endif
-
if(implements_cache[hval].aid==a->id && implements_cache[hval].bid==b->id)
-
{
-
return implements_cache[hval].ret;
-
}
-
/* Do it the tedious way */
-
implements_cache[hval].aid=a->id;
-
implements_cache[hval].bid=b->id;
-
implements_cache[hval].ret = 1; /* Tentatively compatible. */
-
implements_cache[hval].ret = low_implements(a,b);
-
/* NOTE: If low_implements() returns 0, the cache may have received
-
* some false positives. Those should be cleared.
-
*/
-
return implements_cache[hval].ret;
-
}
-
-
/* Returns 1 if a is compatible with b */
-
static int low_is_compatible(struct program *a, struct program *b)
-
{
-
int e;
-
struct pike_string *s=findstring("__INIT");
-
-
/* Optimize the loop somewhat */
-
if (a->num_identifier_references < b->num_identifier_references) {
-
struct program *tmp = a;
-
a = b;
-
b = tmp;
-
}
-
-
for(e=0;e<b->num_identifier_references;e++)
-
{
-
struct identifier *bid;
-
int i;
-
if (b->identifier_references[e].id_flags & (ID_PROTECTED|ID_HIDDEN|ID_VARIANT))
-
continue; /* Skip protected & hidden */
-
-
/* FIXME: What if they aren't protected & hidden in a? */
-
-
bid = ID_FROM_INT(b,e);
-
if(s == bid->name) continue; /* Skip __INIT */
-
i = find_shared_string_identifier(bid->name,a);
-
if (i == -1) {
-
continue; /* It's ok... */
-
}
-
-
/* Note: Uses weaker check for constant integers. */
-
if(((bid->run_time_type != PIKE_T_INT) ||
-
(ID_FROM_INT(a, i)->run_time_type != PIKE_T_INT)) &&
-
!match_types(ID_FROM_INT(a,i)->type, bid->type)) {
-
#if 0
-
fprintf(stderr, "Identifier \"%s\" is incompatible.\n",
-
bid->name->str);
-
#endif /* 0 */
-
return 0;
-
}
-
}
-
return 1;
-
}
-
-
static struct implements_cache_s is_compatible_cache[IMPLEMENTS_CACHE_SIZE];
-
/* Returns 1 if a is compatible with b
-
* ie it's possible to write a hypothetical c that implements both.
-
*/
-
PMOD_EXPORT int is_compatible(struct program *a, struct program *b)
-
{
-
unsigned long hval;
-
unsigned long rhval;
-
int aid, bid;
-
if(!a || !b) return -1;
-
if(a==b) return 1;
-
-
/* Order the id's so we don't need double entries in the cache. */
-
aid = a->id;
-
bid = b->id;
-
if (aid > bid) {
-
int tmp = aid;
-
aid = bid;
-
bid = tmp;
-
}
-
-
hval = aid*9248339 + bid;
-
hval %= IMPLEMENTS_CACHE_SIZE;
-
#ifdef PIKE_DEBUG
-
if(hval >= IMPLEMENTS_CACHE_SIZE)
-
Pike_fatal("Implements_cache failed!\n");
-
#endif
-
if(is_compatible_cache[hval].aid==aid &&
-
is_compatible_cache[hval].bid==bid)
-
{
-
return is_compatible_cache[hval].ret;
-
}
-
if(implements_cache[hval].aid==aid &&
-
implements_cache[hval].bid==bid &&
-
implements_cache[hval].ret)
-
{
-
/* a implements b */
-
return 1;
-
}
-
rhval = bid*9248339 + aid;
-
rhval %= IMPLEMENTS_CACHE_SIZE;
-
#ifdef PIKE_DEBUG
-
if(rhval >= IMPLEMENTS_CACHE_SIZE)
-
Pike_fatal("Implements_cache failed!\n");
-
#endif
-
if(implements_cache[rhval].aid==bid &&
-
implements_cache[rhval].bid==aid &&
-
implements_cache[rhval].ret)
-
{
-
/* b implements a */
-
return 1;
-
}
-
/* Do it the tedious way */
-
is_compatible_cache[hval].aid=aid;
-
is_compatible_cache[hval].bid=bid;
-
is_compatible_cache[hval].ret = 1; /* Tentatively compatible. */
-
is_compatible_cache[hval].ret = low_is_compatible(a,b);
-
/* NOTE: If low_is compatible() returns 0, the cache may have received
-
* some false positives. Those should be cleared.
-
*/
-
return is_compatible_cache[hval].ret;
-
}
-
-
/* Explains why a is not compatible with b */
-
void yyexplain_not_compatible(int severity_level,
-
struct program *a, struct program *b)
-
{
-
int e;
-
struct pike_string *s=findstring("__INIT");
-
int res = 1;
-
INT_TYPE a_line = 0;
-
INT_TYPE b_line = 0;
-
struct pike_string *a_file;
-
struct pike_string *b_file;
-
DECLARE_CYCLIC();
-
-
/* Optimize the loop somewhat */
-
if (a->num_identifier_references < b->num_identifier_references) {
-
struct program *tmp = a;
-
a = b;
-
b = tmp;
-
}
-
-
if (BEGIN_CYCLIC(a, b)) {
-
END_CYCLIC();
-
return;
-
}
-
SET_CYCLIC_RET(1);
-
-
a_file = get_program_line(a, &a_line);
-
b_file = get_program_line(b, &b_line);
-
-
for(e=0;e<b->num_identifier_references;e++)
-
{
-
struct identifier *bid;
-
int i;
-
if (b->identifier_references[e].id_flags & (ID_PROTECTED|ID_HIDDEN|ID_VARIANT))
-
continue; /* Skip protected & hidden */
-
-
/* FIXME: What if they aren't protected & hidden in a? */
-
-
bid = ID_FROM_INT(b,e);
-
if(s == bid->name) continue; /* Skip __INIT */
-
i = find_shared_string_identifier(bid->name,a);
-
if (i == -1) {
-
continue; /* It's ok... */
-
}
-
-
/* Note: Uses weaker check for constant integers. */
-
if(((bid->run_time_type != PIKE_T_INT) ||
-
(ID_FROM_INT(a, i)->run_time_type != PIKE_T_INT)) &&
-
!match_types(ID_FROM_INT(a,i)->type, bid->type)) {
-
INT_TYPE aid_line = a_line;
-
INT_TYPE bid_line = b_line;
-
struct pike_string *aid_file = get_identifier_line(a, i, &aid_line);
-
struct pike_string *bid_file = get_identifier_line(b, e, &bid_line);
-
if (!aid_file) aid_file = a_file;
-
if (!bid_file) bid_file = b_file;
-
ref_push_string(bid->name);
-
ref_push_program(a);
-
ref_push_program(b);
-
yytype_report(severity_level,
-
aid_file, aid_line, ID_FROM_INT(a, i)->type,
-
bid_file, bid_line, bid->type, 3,
-
"Identifier %s in %O is incompatible with the same in %O.");
-
}
-
}
-
free_string(b_file);
-
free_string(a_file);
-
END_CYCLIC();
-
return;
-
}
-
-
/* Explains why a does not implement b */
-
void yyexplain_not_implements(int severity_level,
-
struct program *a, struct program *b)
-
{
-
int e;
-
struct pike_string *s=findstring("__INIT");
-
INT_TYPE a_line = 0;
-
INT_TYPE b_line = 0;
-
struct pike_string *a_file;
-
struct pike_string *b_file;
-
DECLARE_CYCLIC();
-
-
if (BEGIN_CYCLIC(a, b)) {
-
END_CYCLIC();
-
return;
-
}
-
SET_CYCLIC_RET(1);
-
-
a_file = get_program_line(a, &a_line);
-
b_file = get_program_line(b, &b_line);
-
-
for(e=0;e<b->num_identifier_references;e++)
-
{
-
struct identifier *bid;
-
int i;
-
if (b->identifier_references[e].id_flags & (ID_PROTECTED|ID_HIDDEN|ID_VARIANT))
-
continue; /* Skip protected & hidden */
-
bid = ID_FROM_INT(b,e);
-
if(s == bid->name) continue; /* Skip __INIT */
-
i = find_shared_string_identifier(bid->name,a);
-
if (i == -1) {
-
INT_TYPE bid_line = b_line;
-
struct pike_string *bid_file;
-
if (b->identifier_references[e].id_flags & (ID_OPTIONAL))
-
continue; /* It's ok... */
-
bid_file = get_identifier_line(b, e, &bid_line);
-
if (!bid_file) bid_file = b_file;
-
yytype_report(severity_level,
-
bid_file, bid_line, bid->type,
-
a_file, a_line, NULL,
-
0, "Missing identifier %S.", bid->name);
-
continue;
-
}
-
-
if (!pike_types_le(bid->type, ID_FROM_INT(a, i)->type)) {
-
INT_TYPE aid_line = a_line;
-
INT_TYPE bid_line = b_line;
-
struct pike_string *aid_file = get_identifier_line(a, i, &aid_line);
-
struct pike_string *bid_file = get_identifier_line(b, e, &bid_line);
-
if (!aid_file) aid_file = a_file;
-
if (!bid_file) bid_file = b_file;
-
if(!match_types(ID_FROM_INT(a,i)->type, bid->type)) {
-
yytype_report(severity_level,
-
bid_file, bid_line, bid->type,
-
aid_file, aid_line, ID_FROM_INT(a, i)->type,
-
0, "Type of identifier %S does not match.", bid->name);
-
} else {
-
yytype_report((severity_level < REPORT_WARNING)?
-
severity_level : REPORT_WARNING,
-
bid_file, bid_line, bid->type,
-
aid_file, aid_line, ID_FROM_INT(a, i)->type,
-
0, "Type of identifier %S is not strictly compatible.",
-
bid->name);
-
}
-
continue;
-
}
-
}
-
free_string(b_file);
-
free_string(a_file);
-
END_CYCLIC();
-
}
-
-
/* FIXME: Code duplication of yyexplain_not_compatible() above! */
-
/* Explains why a is not compatible with b */
-
void string_builder_explain_not_compatible(struct string_builder *s,
-
struct program *a,
-
struct program *b)
-
{
-
int e;
-
struct pike_string *init_string = findstring("__INIT");
-
int res = 1;
-
DECLARE_CYCLIC();
-
-
/* Optimize the loop somewhat */
-
if (a->num_identifier_references < b->num_identifier_references) {
-
struct program *tmp = a;
-
a = b;
-
b = tmp;
-
}
-
-
if (BEGIN_CYCLIC(a, b)) {
-
END_CYCLIC();
-
return;
-
}
-
SET_CYCLIC_RET(1);
-
-
for(e=0;e<b->num_identifier_references;e++)
-
{
-
struct identifier *bid;
-
int i;
-
if (b->identifier_references[e].id_flags & (ID_PROTECTED|ID_HIDDEN|ID_VARIANT))
-
continue; /* Skip protected & hidden */
-
-
/* FIXME: What if they aren't protected & hidden in a? */
-
-
bid = ID_FROM_INT(b,e);
-
if(init_string == bid->name) continue; /* Skip __INIT */
-
i = find_shared_string_identifier(bid->name,a);
-
if (i == -1) {
-
continue; /* It's ok... */
-
}
-
-
/* Note: Uses weaker check for constant integers. */
-
if(((bid->run_time_type != PIKE_T_INT) ||
-
(ID_FROM_INT(a, i)->run_time_type != PIKE_T_INT)) &&
-
!match_types(ID_FROM_INT(a,i)->type, bid->type)) {
-
ref_push_program(a);
-
ref_push_program(b);
-
ref_push_type_value(ID_FROM_INT(a, i)->type);
-
ref_push_type_value(bid->type);
-
string_builder_sprintf(s,
-
"Identifier %S in %O is incompatible with "
-
"the same in %O.\n"
-
"Expected: %O\n"
-
"Got : %O\n",
-
bid->name, Pike_sp-4,
-
Pike_sp-3,
-
Pike_sp-2,
-
Pike_sp-1);
-
pop_n_elems(4);
-
}
-
}
-
END_CYCLIC();
-
return;
-
}
-
-
/* FIXME: code duplication of yyexplain_not_implements() above! */
-
/* Explains why a does not implement b */
-
void string_builder_explain_not_implements(struct string_builder *s,
-
struct program *a,
-
struct program *b)
-
{
-
int e;
-
struct pike_string *init_string = findstring("__INIT");
-
DECLARE_CYCLIC();
-
-
if (BEGIN_CYCLIC(a, b)) {
-
END_CYCLIC();
-
return;
-
}
-
SET_CYCLIC_RET(1);
-
-
for(e=0;e<b->num_identifier_references;e++)
-
{
-
struct identifier *bid;
-
int i;
-
if (b->identifier_references[e].id_flags & (ID_PROTECTED|ID_HIDDEN|ID_VARIANT))
-
continue; /* Skip protected & hidden */
-
bid = ID_FROM_INT(b,e);
-
if(init_string == bid->name) continue; /* Skip __INIT */
-
i = find_shared_string_identifier(bid->name,a);
-
if (i == -1) {
-
if (b->identifier_references[e].id_flags & (ID_OPTIONAL))
-
continue; /* It's ok... */
-
ref_push_type_value(bid->type);
-
string_builder_sprintf(s,
-
"Missing identifier %O %S.\n",
-
Pike_sp-1, bid->name);
-
pop_stack();
-
continue;
-
}
-
-
if (!pike_types_le(bid->type, ID_FROM_INT(a, i)->type)) {
-
ref_push_type_value(bid->type);
-
ref_push_type_value(ID_FROM_INT(a, i)->type);
-
if(!match_types(ID_FROM_INT(a,i)->type, bid->type)) {
-
string_builder_sprintf(s,
-
"Type of identifier %S does not match.\n"
-
"Expected: %O.\n"
-
"Got : %O.\n",
-
bid->name,
-
Pike_sp-2,
-
Pike_sp-1);
-
} else {
-
string_builder_sprintf(s,
-
"Type of identifier %S is not strictly compatible.",
-
"Expected: %O.\n"
-
"Got : %O.\n",
-
bid->name,
-
Pike_sp-2,
-
Pike_sp-1);
-
}
-
pop_n_elems(2);
-
continue;
-
}
-
}
-
END_CYCLIC();
-
}
-
-
PMOD_EXPORT void *parent_storage(int depth)
-
{
-
struct external_variable_context loc;
-
-
loc.o = Pike_fp->current_object;
-
loc.parent_identifier = 0;
-
loc.inherit = Pike_fp->context;
-
-
find_external_context(&loc, depth);
-
-
if (!loc.o->prog)
-
Pike_error ("Cannot access storage of destructed parent object.\n");
-
-
return loc.o->storage + loc.inherit->storage_offset;
-
}
-
-
PMOD_EXPORT void change_compiler_compatibility(int major, int minor)
-
{
-
CHECK_COMPILER();
-
-
push_int(major);
-
push_int(minor);
-
-
safe_apply_current2(PC_CHANGE_COMPILER_COMPATIBILITY_FUN_NUM, 2,
-
"change_compiler_compatibility");
-
pop_stack();
-
}
-
-
#ifdef PIKE_USE_MACHINE_CODE
-
-
#ifdef HAVE_SYS_MMAN_H
-
#include <sys/mman.h>
-
#endif
-
-
void make_area_executable (char *start, size_t len)
-
{
-
#ifndef USE_MY_MEXEC_ALLOC
-
{
-
/* Perform page alignment. */
-
void *addr = (void *)(((size_t)start) & ~(page_size-1));
-
size_t l = ((start + len) - ((char *)addr) +
-
(page_size - 1)) & ~(page_size-1);
-
-
if (mprotect(addr, l, PROT_EXEC | PROT_READ | PROT_WRITE) < 0) {
-
#if 0
-
fprintf(stderr, "%p:%d: mprotect(%p, %lu, 0x%04x): errno: %d\n",
-
start, len, addr, l, PROT_EXEC | PROT_READ | PROT_WRITE, errno);
-
#endif /* 0 */
-
}
-
}
-
#endif /* !USE_MY_MEXEC_ALLOC */
-
-
#ifdef HAVE_SYNC_INSTRUCTION_MEMORY
-
sync_instruction_memory(start, len);
-
#elif defined(FLUSH_INSTRUCTION_CACHE)
-
FLUSH_INSTRUCTION_CACHE(start, len);
-
#endif /* HAVE_SYNC_INSTRUCTION_MEMORY || FLUSH_INSTRUCTION_CACHE */
-
}
-
-
void make_program_executable(struct program *p)
-
{
-
if (!p->num_program) return;
-
if ((p->event_handler == compat_event_handler) &&
-
((p->num_program * sizeof(p->program[0]) <=
-
(NUM_PROG_EVENTS * sizeof(p->event_handler))))) {
-
/* Only event handlers. */
-
return;
-
}
-
-
make_area_executable ((char *) p->program,
-
p->num_program * sizeof (p->program[0]));
-
}
-
#endif
+
Newline at end of file removed.