mirror of git://git.psyced.org/git/psyclpc
5574 lines
162 KiB
C
5574 lines
162 KiB
C
/*---------------------------------------------------------------------------
|
||
* The runtime module.
|
||
*
|
||
*---------------------------------------------------------------------------
|
||
* simulate is a collection of structures and functions which provide the
|
||
* basic runtime functionality:
|
||
*
|
||
* - the object list
|
||
* - loading, cloning, and destructing objects
|
||
* - the runtime context stack
|
||
* - error handling
|
||
* - function callbacks
|
||
* - management of the driver hooks
|
||
* - handling of object inventories and shadows.
|
||
*
|
||
* The data structures, especially the runtime stack, are described where
|
||
* they are defined.
|
||
*---------------------------------------------------------------------------
|
||
*/
|
||
|
||
#include "driver.h"
|
||
#include "typedefs.h"
|
||
|
||
#include "my-alloca.h"
|
||
#include <fcntl.h>
|
||
#include <setjmp.h>
|
||
#include <stdio.h>
|
||
#include <stdarg.h>
|
||
#include <sys/types.h>
|
||
#include <sys/stat.h>
|
||
#include <signal.h>
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
|
||
#include "simulate.h"
|
||
|
||
#include "actions.h"
|
||
#include "array.h"
|
||
#include "backend.h"
|
||
#include "call_out.h"
|
||
#include "closure.h"
|
||
#include "comm.h"
|
||
#include "ed.h"
|
||
#include "filestat.h"
|
||
#include "gcollect.h"
|
||
#include "heartbeat.h"
|
||
#include "lex.h"
|
||
#include "main.h"
|
||
#include "mapping.h"
|
||
#include "mempools.h"
|
||
#include "mregex.h"
|
||
#include "mstrings.h"
|
||
#include "object.h"
|
||
#include "otable.h"
|
||
#ifdef USE_TLS
|
||
#include "pkg-tls.h"
|
||
#endif
|
||
#ifdef USE_SQLITE
|
||
#include "pkg-sqlite.h"
|
||
#endif
|
||
#include "prolang.h"
|
||
#include "sent.h"
|
||
#include "simul_efun.h"
|
||
#include "stdstrings.h"
|
||
#include "strfuns.h"
|
||
#ifdef USE_STRUCTS
|
||
#include "structs.h"
|
||
#endif
|
||
#include "swap.h"
|
||
#include "svalue.h"
|
||
#include "wiz_list.h"
|
||
#include "xalloc.h"
|
||
|
||
#include "i-eval_cost.h"
|
||
|
||
#include "../mudlib/sys/debug_info.h"
|
||
#include "../mudlib/sys/driver_hook.h"
|
||
#include "../mudlib/sys/files.h"
|
||
#include "../mudlib/sys/regexp.h"
|
||
#include "../mudlib/sys/rtlimits.h"
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
|
||
/* --- struct limits_context_s: last runtime limits context ---
|
||
*
|
||
* This structure saves the runtime limits on the runtime context stack.
|
||
* It is also used as a temporary when parsing limit specifications.
|
||
*/
|
||
|
||
struct limits_context_s
|
||
{
|
||
rt_context_t rt; /* the rt_context superclass */
|
||
size_t max_array; /* max array size */
|
||
size_t max_mapping; /* max mapping size in values */
|
||
size_t max_map_keys; /* max mapping size in entries */
|
||
int32 max_eval; /* max eval cost */
|
||
int32 max_byte; /* max byte xfer */
|
||
int32 max_file; /* max file xfer */
|
||
int32 max_callouts; /* max callouts */
|
||
int32 use_cost; /* the desired cost of the evaluation */
|
||
int32 eval_cost; /* the then-current eval costs used */
|
||
};
|
||
|
||
|
||
/* --- struct give_uid_error_context ---
|
||
*
|
||
* A structure of this type is pushed as error handler on the
|
||
* interpreter stack while a newly created object is given its uids.
|
||
*/
|
||
|
||
struct give_uid_error_context
|
||
{
|
||
svalue_t head; /* A T_ERROR_HANDLER with this struct as arg */
|
||
object_t *new_object; /* The object under processing */
|
||
};
|
||
|
||
|
||
/* --- struct namechain ---
|
||
*
|
||
* This structure is used by load_object() to build the current inheritence
|
||
* chain in the frames on the stack. The information is used to generate
|
||
* proper error messages.
|
||
*/
|
||
|
||
typedef struct namechain_s
|
||
{
|
||
struct namechain_s * prev; /* Pointer to the previous element, or NULL */
|
||
char * name; /* Pointer to the name to load */
|
||
} namechain_t;
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
|
||
/* The runtime context stack.
|
||
*
|
||
* Runtime context informations are maintained in a linked list, with
|
||
* cur_context pointing to the most recently pushed context.
|
||
* From there, the links go back through the less recently pushed contexts
|
||
* and end with the toplevel_context.
|
||
*/
|
||
|
||
struct error_recovery_info toplevel_context
|
||
= {
|
||
{ NULL,
|
||
ERROR_RECOVERY_NONE
|
||
}
|
||
};
|
||
|
||
rt_context_t * rt_context
|
||
= (rt_context_t *)&toplevel_context.rt;
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
|
||
static p_int alloc_shadow_sent = 0;
|
||
/* Statistic: how many shadow sentences have been allocated.
|
||
*/
|
||
|
||
object_t *obj_list = NULL;
|
||
/* Head of the list of all objects. The reference by this list
|
||
* is counted.
|
||
* The first object in the list has its .prev_all member cleared.
|
||
*/
|
||
|
||
object_t *obj_list_end = NULL;
|
||
/* Last object in obj_list. This object also has its .next_all member
|
||
* cleared.
|
||
*/
|
||
|
||
#ifdef CHECK_OBJECT_REF
|
||
object_shadow_t * destructed_obj_shadows = NULL;
|
||
object_shadow_t * newly_destructed_obj_shadows = NULL;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
|
||
object_t *destructed_objs = NULL;
|
||
/* List holding destructed but not yet fully dereferenced objects.
|
||
* Only the name and the program pointer are guarantueed to be valid.
|
||
* The reference by this list is counted.
|
||
* Objects with only the list reference left are finally freed by
|
||
* the function remove_destructed_objects() called from the backend.
|
||
#ifdef GC_SUPPORT
|
||
* They are also freed by a GC.
|
||
#endif
|
||
* TODO: If this turns out to be not soon enough, modify the free_object()
|
||
* TODO:: call to recognize the destructed+one-ref-left situation.
|
||
*
|
||
* This list is not exactly necessary, as destructed objects would be
|
||
* deallcoated automatically once the last reference is gone, but it
|
||
* helps mud admins to figure out where all the memory goes.
|
||
*/
|
||
|
||
long num_destructed = 0;
|
||
/* Statistics: Number of objects in the destructed_objs list.
|
||
*/
|
||
|
||
object_t *newly_destructed_objs = NULL;
|
||
/* List holding objects destructed in this execution thread.
|
||
* They are no longer part of the obj_list, but since programs may still
|
||
* be executing in them, the aren't fully destructed yet.
|
||
*/
|
||
|
||
long num_newly_destructed = 0;
|
||
/* Statistics: Number of objects in the newly_destructed_objs list.
|
||
*/
|
||
|
||
object_t *master_ob = NULL;
|
||
/* The master object.
|
||
*/
|
||
|
||
object_t *current_object = NULL;
|
||
/* The object interpreting a function.
|
||
*/
|
||
|
||
object_t *current_interactive;
|
||
/* The user who caused this execution.
|
||
*/
|
||
|
||
object_t *previous_ob;
|
||
/* The previous object which called the current_object.
|
||
*/
|
||
|
||
svalue_t driver_hook[NUM_DRIVER_HOOKS];
|
||
/* The table with all driver hooks.
|
||
*/
|
||
|
||
Bool game_is_being_shut_down = MY_FALSE;
|
||
/* TRUE if a shutdown was requested resp. is in progress.
|
||
*/
|
||
|
||
Bool master_will_be_updated = MY_FALSE;
|
||
/* TRUE if a master-update was requested.
|
||
*/
|
||
|
||
static Bool in_fatal = MY_FALSE;
|
||
/* TRUE if fatal() is being processed.
|
||
*/
|
||
|
||
int num_error = 0;
|
||
/* Number of recursive calls to errorf().
|
||
*/
|
||
|
||
int num_warning = 0;
|
||
/* Number of recursive calls to warnf().
|
||
*/
|
||
|
||
static char emsg_buf[ERROR_BUF_LEN];
|
||
/* The buffer for the error message to be created.
|
||
*/
|
||
|
||
string_t *current_error;
|
||
string_t *current_error_file;
|
||
string_t *current_error_object_name;
|
||
mp_int current_error_line_number;
|
||
/* When an error occured during secure_apply(), these four
|
||
* variables receive allocated copies (resp. counted refs) of
|
||
* the error message, the name of the active program and object, and the
|
||
* line number in the program.
|
||
*/
|
||
|
||
vector_t *uncaught_error_trace = NULL;
|
||
vector_t *current_error_trace = NULL;
|
||
/* When an error occured, these variables hold the call chain in the
|
||
* format used by efun debug_info() for evaluation by the mudlib.
|
||
* The variables are kept until the next error, or until a GC.
|
||
* 'uncaught_error_trace': the most recent uncaught error
|
||
* 'current_error_trace': the most recent error, caught or uncaught.
|
||
*/
|
||
|
||
/* --- Runtime limits --- */
|
||
|
||
/* Each of these limits comes as pair: one def_... value which holds the
|
||
* limit set at startup or with the set_limits() efun, and the max_...
|
||
* value which holds the limit currently in effect. Before every execution,
|
||
* max_... are initialised from def_... with the RESET_LIMITS macro.
|
||
*
|
||
* A limit of 0 usually means 'no limit'.
|
||
*/
|
||
|
||
size_t def_array_size = MAX_ARRAY_SIZE;
|
||
size_t max_array_size = MAX_ARRAY_SIZE;
|
||
/* If != 0: the max. number of elements in an array.
|
||
*/
|
||
|
||
size_t def_mapping_size = MAX_MAPPING_SIZE;
|
||
size_t max_mapping_size = MAX_MAPPING_SIZE;
|
||
/* If != 0: the max. number of elements in a mapping.
|
||
*/
|
||
|
||
size_t def_mapping_keys = MAX_MAPPING_KEYS;
|
||
size_t max_mapping_keys = MAX_MAPPING_KEYS;
|
||
/* If != 0: the max. number of entries in a mapping.
|
||
*/
|
||
|
||
int32 def_eval_cost = MAX_COST;
|
||
int32 max_eval_cost = MAX_COST;
|
||
/* The max eval cost available for one execution thread. Stored as negative
|
||
* value for easier initialisation (see eval_cost).
|
||
* CLEAR_EVAL_COST uses this value to re-initialize (assigned_)eval_cost.
|
||
*/
|
||
|
||
int32 use_eval_cost = DEF_USE_EVAL_COST;
|
||
/* How to account for the cost of the current evaluation.
|
||
* > 0: the cost to use regardless of actual cost.
|
||
* == 0: use the actual cost if the max_eval limit was less than the
|
||
* default; use 10 ticks if it was more.
|
||
* < 0: use -val% of the actual cost
|
||
*/
|
||
|
||
int32 def_byte_xfer = MAX_BYTE_TRANSFER;
|
||
int32 max_byte_xfer = MAX_BYTE_TRANSFER;
|
||
/* Maximum number of bytes to read/write in one read/write_bytes() call.
|
||
* If 0, it is unlimited.
|
||
*/
|
||
|
||
int32 def_file_xfer = READ_FILE_MAX_SIZE;
|
||
int32 max_file_xfer = READ_FILE_MAX_SIZE;
|
||
/* Maximum number of bytes to read/write in one read/write_file() call.
|
||
*/
|
||
|
||
int32 def_callouts = MAX_CALLOUTS;
|
||
int32 max_callouts = MAX_CALLOUTS;
|
||
/* If != 0: the max. number of callouts at one time.
|
||
*/
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
/* Forward declarations */
|
||
|
||
static void free_shadow_sent (shadow_t *p);
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
Bool
|
||
catch_instruction ( int flags, uint offset
|
||
, volatile svalue_t ** volatile i_sp
|
||
, bytecode_p i_pc, svalue_t * i_fp
|
||
, int32 reserve_cost
|
||
#ifdef USE_NEW_INLINES
|
||
, svalue_t * i_context
|
||
#endif /* USE_NEW_INLINES */
|
||
)
|
||
|
||
/* Implement the F_CATCH instruction.
|
||
*
|
||
* At the time of call, all important locals from eval_instruction() are
|
||
* have been stored in their global locations.
|
||
*
|
||
* Result is TRUE on a normal exit (error or not), and FALSE if the
|
||
* guarded code terminated with a 'return' itself;
|
||
*
|
||
* Hard experience showed that it is advantageous to have setjmp()
|
||
* to have its own stackframe, and call the longjmp() from a deeper
|
||
* frame. Additionally it prevents over-optimistic optimizers from
|
||
* removing vital reloads of possibly clobbered local variables after
|
||
* the setjmp().
|
||
*/
|
||
|
||
{
|
||
#define INTER_SP ((svalue_t *)(*i_sp))
|
||
|
||
Bool rc;
|
||
volatile Bool old_out_of_memory = out_of_memory;
|
||
|
||
bytecode_p new_pc; /* Address of first instruction after the catch() */
|
||
|
||
/* Compute address of next instruction after the CATCH statement.
|
||
*/
|
||
new_pc = i_pc + offset;
|
||
|
||
/* 'Fake' a subroutine call from <new_pc>
|
||
*/
|
||
#ifdef USE_NEW_INLINES
|
||
push_control_stack(INTER_SP, new_pc, i_fp, i_context);
|
||
#else
|
||
push_control_stack(INTER_SP, new_pc, i_fp);
|
||
#endif /* USE_NEW_INLINES */
|
||
csp->ob = current_object;
|
||
csp->extern_call = MY_FALSE;
|
||
csp->catch_call = MY_TRUE;
|
||
#ifndef DEBUG
|
||
csp->num_local_variables = 0; /* No extra variables */
|
||
#else
|
||
csp->num_local_variables = (csp-1)->num_local_variables;
|
||
/* TODO: Marion added this, but why? For 'expected_stack'? */
|
||
#endif
|
||
csp->funstart = csp[-1].funstart;
|
||
|
||
/* Save some globals on the error stack that must be restored
|
||
* separately after a longjmp, then set the jump.
|
||
*/
|
||
if ( setjmp( push_error_context(INTER_SP, flags)->text ) )
|
||
{
|
||
/* A throw() or error occured. We have to restore the
|
||
* control and error stack manually here.
|
||
*
|
||
* The error value to return will be stored in
|
||
* the global <catch_value>.
|
||
*/
|
||
svalue_t *sp;
|
||
svalue_t catch_value;
|
||
|
||
/* Remove the catch context and get the old stackpointer setting */
|
||
sp = pull_error_context(INTER_SP, &catch_value);
|
||
|
||
/* beware of errors after set_this_object() */
|
||
current_object = csp->ob;
|
||
|
||
/* catch() faked a subroutine call internally, which has to be
|
||
* undone again. This will also set the pc to the proper
|
||
* continuation address.
|
||
*/
|
||
pop_control_stack();
|
||
|
||
/* Push the catch return value */
|
||
*(++sp) = catch_value;
|
||
|
||
*i_sp = (volatile svalue_t *)sp;
|
||
|
||
/* Restore the old eval costs */
|
||
eval_cost -= reserve_cost;
|
||
assigned_eval_cost -= reserve_cost;
|
||
|
||
/* If we ran out of memory, throw a new error */
|
||
if (!old_out_of_memory && out_of_memory)
|
||
{
|
||
errorf("(catch) Out of memory detected.\n");
|
||
}
|
||
|
||
rc = MY_TRUE;
|
||
}
|
||
else
|
||
{
|
||
|
||
/* Increase the eval_cost for the duration of the catch so that
|
||
* there is enough time left to handle an eval-too-big error.
|
||
* Do this before the check as the error handling will subtract
|
||
* the reserve again.
|
||
*/
|
||
eval_cost += reserve_cost;
|
||
assigned_eval_cost += reserve_cost;
|
||
|
||
if (max_eval_cost && eval_cost >= max_eval_cost)
|
||
{
|
||
errorf("Not enough eval time left for catch(): required %"PRId32
|
||
", available %"PRId32"\n", reserve_cost,
|
||
(max_eval_cost - eval_cost + reserve_cost)
|
||
);
|
||
/* NOTREACHED */
|
||
return MY_TRUE;
|
||
}
|
||
|
||
/* Recursively call the interpreter */
|
||
rc = eval_instruction(i_pc, INTER_SP);
|
||
|
||
if (rc)
|
||
{
|
||
/* Get rid of the code result */
|
||
pop_stack();
|
||
|
||
/* Restore the old execution context */
|
||
pop_control_stack();
|
||
pop_error_context();
|
||
|
||
/* Since no error happened, push 0 onto the stack */
|
||
push_number(inter_sp, 0);
|
||
}
|
||
|
||
eval_cost -= reserve_cost;
|
||
assigned_eval_cost -= reserve_cost;
|
||
}
|
||
|
||
return rc;
|
||
} /* catch_instruction() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static INLINE void
|
||
save_limits_context (struct limits_context_s * context)
|
||
|
||
/* Save the current limits context into <context> (but don't put it
|
||
* onto the context stack).
|
||
*/
|
||
|
||
{
|
||
context->rt.type = LIMITS_CONTEXT;
|
||
context->max_array = max_array_size;
|
||
context->max_callouts = max_callouts;
|
||
context->max_mapping = max_mapping_size;
|
||
context->max_map_keys = max_mapping_keys;
|
||
context->max_eval = max_eval_cost;
|
||
context->eval_cost = eval_cost;
|
||
context->max_byte = max_byte_xfer;
|
||
context->max_file = max_file_xfer;
|
||
context->use_cost = use_eval_cost;
|
||
} /* save_limits_context() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static INLINE void
|
||
restore_limits_context (struct limits_context_s * context)
|
||
|
||
/* Restore the last runtime limits from <context>.
|
||
*
|
||
* Restoring max_eval_cost is a bit tricky since eval_cost
|
||
* itself might be a bit too high for the restored limit, but
|
||
* avoiding a 'eval-cost too high' was the point of the exercise
|
||
* in the first place. Therefore, if we ran under a less limited
|
||
* eval-cost limit, we fake an effective cost of 10 ticks.
|
||
*/
|
||
|
||
{
|
||
assign_eval_cost();
|
||
if (use_eval_cost == 0)
|
||
{
|
||
if (!max_eval_cost || max_eval_cost > context->max_eval)
|
||
{
|
||
assigned_eval_cost = eval_cost = context->eval_cost+10;
|
||
}
|
||
}
|
||
else if (use_eval_cost > 0)
|
||
{
|
||
int32 elapsed_cost = eval_cost - context->eval_cost;
|
||
|
||
if (elapsed_cost > use_eval_cost)
|
||
assigned_eval_cost = eval_cost = use_eval_cost + context->eval_cost;
|
||
assigned_eval_cost = eval_cost;
|
||
}
|
||
else /* (use_eval_cost < 0) */
|
||
{
|
||
int32 elapsed_cost = eval_cost - context->eval_cost;
|
||
int32 whole_fact = (-use_eval_cost) / 100;
|
||
int32 fract_fact = (-use_eval_cost) % 100;
|
||
eval_cost = context->eval_cost
|
||
+ elapsed_cost * whole_fact
|
||
+ elapsed_cost * fract_fact / 100;
|
||
assigned_eval_cost = eval_cost;
|
||
}
|
||
max_array_size = context->max_array;
|
||
max_mapping_size = context->max_mapping;
|
||
max_mapping_keys = context->max_map_keys;
|
||
max_callouts = context->max_callouts;
|
||
max_eval_cost = context->max_eval;
|
||
max_byte_xfer = context->max_byte;
|
||
max_file_xfer = context->max_file;
|
||
use_eval_cost = context->use_cost;
|
||
} /* restore_limits_context() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static void
|
||
unroll_context_stack (void)
|
||
|
||
/* Remove entries from the rt_context stack until the last entry
|
||
* is an ERROR_RECOVERY context.
|
||
*/
|
||
|
||
{
|
||
while (!ERROR_RECOVERY_CONTEXT(rt_context->type))
|
||
{
|
||
rt_context_t * context = rt_context;
|
||
|
||
rt_context = rt_context->last;
|
||
switch(context->type)
|
||
{
|
||
#ifdef USE_ACTIONS
|
||
case COMMAND_CONTEXT:
|
||
restore_command_context(context);
|
||
break;
|
||
#endif
|
||
|
||
case LIMITS_CONTEXT:
|
||
restore_limits_context((struct limits_context_s *)context);
|
||
break;
|
||
|
||
default:
|
||
fatal("Unimplemented context type %d.\n", context->type);
|
||
/* NOTREACHED */
|
||
}
|
||
}
|
||
} /* unroll_context_stack() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static INLINE void dump_core(void) NORETURN;
|
||
|
||
static INLINE void
|
||
dump_core(void)
|
||
|
||
/* A wrapper around abort() to make sure that we indeed dump a core.
|
||
*/
|
||
|
||
{
|
||
#if !defined(__BEOS__)
|
||
/* we want a core dump, and abort() seems to fail for linux and sun */
|
||
(void)signal(SIGFPE, SIG_DFL);
|
||
{
|
||
int a = 0; /* avoids a pesky diagnostic */
|
||
*((char*)0) = 0/a;
|
||
*((char*)fatal) = 0/a;
|
||
}
|
||
#endif
|
||
abort();
|
||
} /* dump_core() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
fatal (const char *fmt, ...)
|
||
|
||
/* A fatal error occured. Generate a message from printf-style <fmt>, including
|
||
* a timestamp, dump the backtrace and abort.
|
||
*/
|
||
|
||
{
|
||
va_list va;
|
||
char *ts;
|
||
|
||
/* Prevent double fatal. */
|
||
if (in_fatal)
|
||
{
|
||
dump_core();
|
||
}
|
||
in_fatal = MY_TRUE;
|
||
|
||
ts = time_stamp();
|
||
|
||
va_start(va, fmt);
|
||
|
||
#ifdef VERBOSE
|
||
fflush(stdout);
|
||
fprintf(stderr, "%s ", ts);
|
||
vfprintf(stderr, fmt, va);
|
||
fflush(stderr);
|
||
if (current_object)
|
||
fprintf(stderr, "%s Current object was %s\n"
|
||
, ts, current_object->name
|
||
? get_txt(current_object->name) : "<null>");
|
||
#endif
|
||
debug_message("%s ", ts);
|
||
vdebug_message(fmt, va);
|
||
if (current_object)
|
||
debug_message("%s Current object was %s\n"
|
||
, ts, current_object->name
|
||
? get_txt(current_object->name) : "<null>");
|
||
debug_message("%s Dump of the call chain:\n", ts);
|
||
(void)dump_trace(MY_TRUE, NULL);
|
||
#ifdef VERBOSE
|
||
printf("%s " PROGNAME " aborting on fatal error.\n", time_stamp());
|
||
fflush(stdout);
|
||
#else
|
||
debug_message("%s " PROGNAME " aborting on fatal error.\n", time_stamp());
|
||
#endif
|
||
|
||
sleep(1); /* let stdout settle down... abort can ignore the buffer... */
|
||
|
||
va_end(va);
|
||
|
||
/* Before shutting down, try to inform the game about it */
|
||
push_ref_string(inter_sp, STR_FATAL_ERROR);
|
||
callback_master(STR_SHUTDOWN, 1);
|
||
|
||
/* Mandatory cleanups */
|
||
#ifdef USE_TLS
|
||
tls_global_deinit();
|
||
#endif
|
||
|
||
/* Dump core and exit */
|
||
dump_core();
|
||
} /* fatal() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
char *
|
||
limit_error_format (char *fixed_fmt, size_t fixed_fmt_len, const char *fmt)
|
||
|
||
/* Safety function for error messages: in the error message <fmt>
|
||
* every '%s' spec is changed to '%.200s' to avoid buffer overflows.
|
||
* The modified format string is stored in <fixed_fmt> (a caller provided
|
||
* buffer of size <fixed_fmd_len>) which is also returned as result.
|
||
*/
|
||
|
||
{
|
||
char *ffptr;
|
||
|
||
ffptr = fixed_fmt;
|
||
while (*fmt && ffptr < fixed_fmt + fixed_fmt_len-1)
|
||
{
|
||
if ((*ffptr++=*fmt++)=='%')
|
||
{
|
||
if (*fmt == 's')
|
||
{
|
||
*ffptr++ = '.';
|
||
*ffptr++ = '2';
|
||
*ffptr++ = '0';
|
||
*ffptr++ = '0';
|
||
}
|
||
}
|
||
}
|
||
|
||
if (*fmt)
|
||
{
|
||
/* We reached the end of the fixed_fmt buffer before
|
||
* the <fmt> string was complete: mark this error message
|
||
* as truncated.
|
||
* ffptr points to the last byte in the <fixed_fmt> buffer.
|
||
*/
|
||
ffptr[-3] = '.';
|
||
ffptr[-2] = '.';
|
||
ffptr[-1] = '.';
|
||
}
|
||
|
||
*ffptr = '\0';
|
||
return fixed_fmt;
|
||
} /* limit_error_format() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
errorf (const char *fmt, ...)
|
||
|
||
/* A system runtime error occured: generate a message from printf-style
|
||
* <fmt> with a timestamp, and handle it.
|
||
* If the error is caught, just dump the trace on stderr, and jump to the
|
||
* error handler, otherwise call the mudlib's error functions (this may cause
|
||
* recursive calls to errorf()) and jump back to wherever the current error
|
||
* recovery context points to.
|
||
*
|
||
* The runtime context stack is unrolled as far as necessary.
|
||
* TODO: Add a perrorf(<prefmt>, <postfmt>,...) function which translates the
|
||
* TODO:: errno into a string and calls errorf(<prefmt><errmsg><postfmt>, ...).
|
||
*/
|
||
|
||
{
|
||
rt_context_t *rt;
|
||
string_t *object_name = NULL;
|
||
char *ts;
|
||
svalue_t *svp;
|
||
Bool error_caught;
|
||
/* TRUE: User catches this error.
|
||
*/
|
||
Bool published_catch;
|
||
/* TRUE: this is a catch which wants runtime_error to be called
|
||
*/
|
||
Bool do_save_error;
|
||
string_t *file; /* program name */
|
||
string_t *malloced_error; /* copy of emsg_buf+1 */
|
||
string_t *malloced_file = NULL; /* copy of program name */
|
||
string_t *malloced_name = NULL; /* copy of the object name */
|
||
object_t *curobj = NULL; /* Verified current object */
|
||
char fixed_fmt[ERROR_FMT_LEN];
|
||
/* Note: When changing this buffer, also change the HEAP_STACK_GAP
|
||
* limit in xalloc.c!
|
||
*/
|
||
mp_int line_number = 0;
|
||
va_list va;
|
||
|
||
/* Errors during the fatal() processing will abort the process
|
||
* immediately.
|
||
*/
|
||
if (in_fatal)
|
||
fatal("Error during fatal().");
|
||
|
||
ts = time_stamp();
|
||
|
||
/* Find the last error recovery context, but do not yet unroll
|
||
* the stack: the current command context might be needed
|
||
* in the runtime error apply.
|
||
*/
|
||
for ( rt = rt_context
|
||
; !ERROR_RECOVERY_CONTEXT(rt->type)
|
||
; rt = rt->last) NOOP;
|
||
|
||
va_start(va, fmt);
|
||
|
||
/* Make fmt sane */
|
||
fmt = limit_error_format(fixed_fmt, sizeof(fixed_fmt), fmt);
|
||
|
||
/* Check the current object */
|
||
curobj = NULL;
|
||
if (current_object != NULL
|
||
&& current_object != &dummy_current_object_for_loads)
|
||
curobj = current_object;
|
||
|
||
if (curobj)
|
||
assign_eval_cost();
|
||
|
||
/* We allow recursive errors only from "sensitive" environments.
|
||
*/
|
||
if (num_error && rt->type <= ERROR_RECOVERY_APPLY)
|
||
{
|
||
static char *times_word[] = {
|
||
"",
|
||
"Double",
|
||
"Triple",
|
||
"Quadruple",
|
||
};
|
||
debug_message("%s %s fault, last error was: %s"
|
||
, ts, times_word[num_error]
|
||
, emsg_buf + 1
|
||
);
|
||
}
|
||
|
||
/* Generate the error message */
|
||
vsprintf(emsg_buf+1, fmt, va);
|
||
va_end(va);
|
||
|
||
emsg_buf[0] = '*'; /* all system errors get a * at the start */
|
||
|
||
error_caught = MY_FALSE;
|
||
published_catch = MY_FALSE;
|
||
|
||
if (rt->type >= ERROR_RECOVERY_CATCH)
|
||
{
|
||
/* User catches this error */
|
||
|
||
error_caught = MY_TRUE;
|
||
|
||
/* Try to copy the error message into the catch value.
|
||
* If we run out of memory here, we won't execute the catch.
|
||
*/
|
||
{
|
||
string_t * str = new_mstring(emsg_buf);
|
||
|
||
if (NULL != str)
|
||
{
|
||
svalue_t stmp;
|
||
|
||
put_string(&stmp, str);
|
||
transfer_error_message(&stmp, rt);
|
||
}
|
||
else
|
||
{
|
||
error_caught = MY_FALSE;
|
||
|
||
/* Unroll the context stack even further until the
|
||
* previous non-catch error recovery frame.
|
||
*/
|
||
for (
|
||
; !ERROR_RECOVERY_CONTEXT(rt->type)
|
||
&& rt->type >= ERROR_RECOVERY_CATCH
|
||
; rt = rt->last) NOOP;
|
||
}
|
||
}
|
||
}
|
||
|
||
if (error_caught)
|
||
{
|
||
struct error_recovery_info * eri = (struct error_recovery_info *)rt;
|
||
|
||
published_catch = (eri->flags & CATCH_FLAG_PUBLISH);
|
||
|
||
if (!out_of_memory)
|
||
{
|
||
if (!(eri->flags & CATCH_FLAG_NOLOG))
|
||
{
|
||
/* Even though caught, dump the backtrace - it makes mudlib
|
||
* debugging much easier. lynX 2007 would like to add:
|
||
*
|
||
* There are two different styles of catch backtrace:
|
||
* When the error happens at compilation time, then the
|
||
* details are printed first, then we get here and print
|
||
* out the backtrace. Further information is redundant
|
||
* but doesn't hurt.
|
||
*
|
||
* But there is also the kind of catch that happens at
|
||
* runtime. In that case there is no error ahead, or not
|
||
* a precise one. Then comes the backtrace, and to avoid
|
||
* confusion in that case it is important to output the
|
||
* emsg at the *end* of the backtrace so it is close to
|
||
* the file actually producing the error, not the one
|
||
* where the event loop started out from.
|
||
*
|
||
* In the past this was confusionary - Beginners would
|
||
* look for the bug at the wrong end of the backtrace
|
||
* where they only find an input_to callback or similar.
|
||
*/
|
||
#ifdef USE_LDMUD_COMPATIBILITY
|
||
debug_message("%s Caught error: %s", ts, emsg_buf + 1);
|
||
# ifdef VERBOSE
|
||
printf("%s Caught error: %s", ts, emsg_buf + 1);
|
||
# endif
|
||
#else
|
||
debug_message("%s ERROR caught. Backtrace:\n", ts);
|
||
#endif
|
||
if (current_error_trace)
|
||
{
|
||
free_array(current_error_trace);
|
||
current_error_trace = NULL;
|
||
}
|
||
object_name = dump_trace(MY_FALSE, ¤t_error_trace);
|
||
#ifdef USE_LDMUD_COMPATIBILITY
|
||
debug_message("%s ... execution continues.\n", ts);
|
||
# ifdef VERBOSE
|
||
printf("%s ... execution continues.\n", ts);
|
||
# endif
|
||
#else
|
||
debug_message("Recovering from: %s\n", emsg_buf + 1);
|
||
/* Intentional double newline */
|
||
#endif
|
||
}
|
||
else
|
||
{
|
||
/* No dump of the backtrace into the log, but we want it
|
||
* available for debug_info().
|
||
*/
|
||
if (current_error_trace)
|
||
{
|
||
free_array(current_error_trace);
|
||
current_error_trace = NULL;
|
||
}
|
||
object_name = collect_trace(NULL, ¤t_error_trace);
|
||
}
|
||
}
|
||
else /* We're running low on memory. */
|
||
{
|
||
if (current_error_trace)
|
||
{
|
||
free_array(current_error_trace);
|
||
current_error_trace = NULL;
|
||
}
|
||
object_name = STR_UNKNOWN_OBJECT;
|
||
}
|
||
|
||
if (!published_catch)
|
||
{
|
||
unroll_context_stack();
|
||
longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
|
||
fatal("Catch() longjump failed");
|
||
}
|
||
}
|
||
|
||
/* Error not caught by the program, or catch() requests the
|
||
* runtime_error() is to be called.
|
||
*/
|
||
|
||
num_error++;
|
||
if (num_error > 3)
|
||
fatal("Too many simultaneous errors.\n");
|
||
|
||
debug_message("%s ", ts);
|
||
debug_message("%s", emsg_buf+1);
|
||
|
||
do_save_error = MY_FALSE;
|
||
|
||
/* Get a copy of the error message */
|
||
malloced_error = new_mstring(emsg_buf+1);
|
||
|
||
/* If we have a current_object, determine the program location
|
||
* of the fault.
|
||
*/
|
||
if (curobj)
|
||
{
|
||
line_number = get_line_number_if_any(&file);
|
||
debug_message("%s program: %s, object: %s line %"PRIdMPINT"\n"
|
||
, ts, get_txt(file), get_txt(curobj->name)
|
||
, line_number);
|
||
if (current_prog && num_error < 3)
|
||
{
|
||
do_save_error = MY_TRUE;
|
||
}
|
||
|
||
malloced_file = file; /* Adopt reference */
|
||
malloced_name = ref_mstring(curobj->name);
|
||
}
|
||
|
||
/* On a triple error, duplicate the error messages so far on stdout */
|
||
|
||
if (num_error == 3)
|
||
{
|
||
/* Error context is secure_apply() */
|
||
|
||
printf("%s error in function call: %s", ts, emsg_buf+1);
|
||
if (curobj)
|
||
{
|
||
printf("%s program: %s, object: %s line %"PRIdMPINT"\n"
|
||
, ts, get_txt(file), get_txt(curobj->name)
|
||
, line_number
|
||
);
|
||
}
|
||
}
|
||
|
||
/* Dump the backtrace (unless already done) */
|
||
if (!published_catch)
|
||
{
|
||
if (uncaught_error_trace)
|
||
{
|
||
free_array(uncaught_error_trace);
|
||
uncaught_error_trace = NULL;
|
||
}
|
||
if (current_error_trace)
|
||
{
|
||
free_array(current_error_trace);
|
||
current_error_trace = NULL;
|
||
}
|
||
|
||
object_name = dump_trace(num_error == 3, ¤t_error_trace);
|
||
if (!published_catch)
|
||
uncaught_error_trace = ref_array(current_error_trace);
|
||
fflush(stdout);
|
||
}
|
||
|
||
if (rt->type == ERROR_RECOVERY_APPLY)
|
||
{
|
||
/* Error context is secure_apply() */
|
||
|
||
current_error = malloced_error;
|
||
current_error_file = malloced_file;
|
||
current_error_object_name = malloced_name;
|
||
current_error_line_number = line_number;
|
||
|
||
if (out_of_memory)
|
||
{
|
||
if (malloced_error)
|
||
{
|
||
free_mstring(malloced_error);
|
||
malloced_error = NULL;
|
||
}
|
||
if (malloced_file)
|
||
{
|
||
free_mstring(malloced_file);
|
||
malloced_file = NULL;
|
||
}
|
||
if (malloced_name)
|
||
{
|
||
free_mstring(malloced_name);
|
||
malloced_name = NULL;
|
||
}
|
||
if (current_error_trace)
|
||
{
|
||
free_array(current_error_trace);
|
||
current_error_trace = NULL;
|
||
}
|
||
if (uncaught_error_trace)
|
||
{
|
||
free_array(uncaught_error_trace);
|
||
uncaught_error_trace = NULL;
|
||
}
|
||
}
|
||
unroll_context_stack();
|
||
longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
|
||
}
|
||
|
||
/* If the error is not caught at all, the stack must be brought in a
|
||
* usable state. After the call to reset_machine(), all arguments to
|
||
* errorf() are invalid, and may not be used any more. The reason is that
|
||
* some strings may have been on the stack machine stack, and have been
|
||
* deallocated.
|
||
*/
|
||
|
||
if (!published_catch)
|
||
reset_machine(MY_FALSE);
|
||
|
||
if (do_save_error)
|
||
{
|
||
save_error(emsg_buf, get_txt(file), line_number);
|
||
}
|
||
|
||
if (object_name)
|
||
{
|
||
/* Error occured in a heart_beat() function */
|
||
|
||
object_t *ob;
|
||
|
||
ob = find_object(object_name);
|
||
if (!ob)
|
||
{
|
||
#ifdef USE_LDMUD_COMPATIBILITY
|
||
if (command_giver && num_error < 2)
|
||
add_message("error when executing program in destroyed object %s\n",
|
||
get_txt(object_name));
|
||
#endif
|
||
debug_message("%s error when executing program in destroyed object %s\n"
|
||
, ts, get_txt(object_name));
|
||
}
|
||
}
|
||
|
||
if (num_error == 3)
|
||
{
|
||
debug_message("%s Master failure: %s", ts, emsg_buf+1);
|
||
#ifdef VERBOSE
|
||
printf("%s Master failure: %s", ts, emsg_buf+1);
|
||
#endif
|
||
}
|
||
else if (!out_of_memory)
|
||
{
|
||
/* We have memory: call master:runtime(), and maybe
|
||
* also master:heart_beat_error().
|
||
*/
|
||
|
||
int a;
|
||
object_t *save_cmd;
|
||
object_t *culprit = NULL;
|
||
|
||
|
||
if (!published_catch)
|
||
{
|
||
CLEAR_EVAL_COST;
|
||
RESET_LIMITS;
|
||
}
|
||
|
||
push_ref_string(inter_sp, malloced_error);
|
||
a = 1;
|
||
if (curobj)
|
||
{
|
||
push_ref_string(inter_sp, malloced_file);
|
||
push_ref_string(inter_sp, malloced_name);
|
||
push_number(inter_sp, line_number);
|
||
a += 3;
|
||
}
|
||
|
||
if (current_heart_beat)
|
||
{
|
||
/* Heartbeat error: turn off the heartbeat in the object
|
||
* and also pass it to RUNTIME_ERROR.
|
||
*/
|
||
|
||
culprit = current_heart_beat;
|
||
current_heart_beat = NULL;
|
||
set_heart_beat(culprit, MY_FALSE);
|
||
debug_message("%s Heart beat in %s turned off.\n"
|
||
, time_stamp(), get_txt(culprit->name));
|
||
push_ref_valid_object(inter_sp, culprit, "heartbeat error");
|
||
a++;
|
||
}
|
||
else
|
||
{
|
||
if (!curobj)
|
||
{
|
||
/* Push dummy values to keep the argument order correct */
|
||
push_number(inter_sp, 0);
|
||
push_number(inter_sp, 0);
|
||
push_number(inter_sp, 0);
|
||
a += 3;
|
||
}
|
||
|
||
/* Normal error: push -1 instead of a culprit. */
|
||
push_number(inter_sp, -1);
|
||
a++;
|
||
}
|
||
|
||
push_number(inter_sp, error_caught ? 1 : 0);
|
||
a++;
|
||
|
||
save_cmd = command_giver;
|
||
apply_master(STR_RUNTIME, a);
|
||
command_giver = save_cmd;
|
||
|
||
if (culprit)
|
||
{
|
||
/* TODO: Merge heart_beat_error() in to runtime_error() */
|
||
|
||
/* Heartbeat error: call the master to log it
|
||
* and to see if the heartbeat shall be turned
|
||
* back on for this object.
|
||
*/
|
||
|
||
push_ref_valid_object(inter_sp, culprit, "runtime_error");
|
||
push_ref_string(inter_sp, malloced_error);
|
||
a = 2;
|
||
if (curobj)
|
||
{
|
||
push_ref_string(inter_sp, malloced_file);
|
||
push_ref_string(inter_sp, malloced_name);
|
||
push_number(inter_sp, line_number);
|
||
a += 3;
|
||
}
|
||
|
||
push_number(inter_sp, error_caught ? 1 : 0);
|
||
a++;
|
||
|
||
svp = apply_master(STR_HEART_ERROR, a);
|
||
command_giver = save_cmd;
|
||
if (svp && (svp->type != T_NUMBER || svp->u.number) )
|
||
{
|
||
debug_message("%s Heart beat in %s turned back on.\n"
|
||
, time_stamp(), get_txt(culprit->name));
|
||
set_heart_beat(culprit, MY_TRUE);
|
||
}
|
||
}
|
||
|
||
/* Handling errors is expensive! */
|
||
if (!published_catch)
|
||
assigned_eval_cost = eval_cost += MASTER_RESERVED_COST;
|
||
}
|
||
|
||
/* Clean up */
|
||
if (malloced_error)
|
||
{
|
||
free_mstring(malloced_error);
|
||
malloced_error = NULL;
|
||
}
|
||
if (malloced_file)
|
||
{
|
||
free_mstring(malloced_file);
|
||
malloced_file = NULL;
|
||
}
|
||
if (malloced_name)
|
||
{
|
||
free_mstring(malloced_name);
|
||
malloced_name = NULL;
|
||
}
|
||
|
||
num_error--;
|
||
|
||
if (current_interactive)
|
||
{
|
||
interactive_t *i;
|
||
|
||
if (O_SET_INTERACTIVE(i, current_interactive)
|
||
&& i->noecho & NOECHO_STALE)
|
||
{
|
||
set_noecho(i, 0, MY_FALSE, MY_FALSE);
|
||
}
|
||
}
|
||
|
||
/* Unroll the context stack and find the recovery context to jump to. */
|
||
|
||
if (published_catch)
|
||
{
|
||
unroll_context_stack();
|
||
longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
|
||
fatal("Catch() longjump failed");
|
||
}
|
||
|
||
unroll_context_stack();
|
||
if (rt_context->type != ERROR_RECOVERY_NONE)
|
||
longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
|
||
|
||
fatal("Can't recover from error (longjmp failed)\n");
|
||
} /* errorf() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
warnf (char *fmt, ...)
|
||
|
||
/* A system runtime warning occured: generate a message from printf-style
|
||
* <fmt> with a timestamp, and print it using debug_message(). The message
|
||
* is also passed to master::runtime_warning().
|
||
*
|
||
* Note: Both 'warn' and 'warning' are already taken on some systems.
|
||
* TODO: Add a pwarnf(<prefmt>, <postfmt>,...) function which translates the
|
||
* TODO:: errno into a string and calls errorf(<prefmt><errmsg><postfmt>, ...).
|
||
*/
|
||
|
||
{
|
||
char *ts;
|
||
string_t *file = NULL; /* program name */
|
||
object_t *curobj = NULL; /* Verified current object */
|
||
char msg_buf[10000];
|
||
/* The buffer for the error message to be created.
|
||
*/
|
||
char fixed_fmt[2000];
|
||
/* Note: When changing this buffer, also change the HEAP_STACK_GAP
|
||
* limit in xalloc.c!
|
||
*/
|
||
mp_int line_number = 0;
|
||
Bool inside_catch;
|
||
/* TRUE: Code is executed inside a catch.
|
||
*/
|
||
va_list va;
|
||
|
||
num_warning++;
|
||
|
||
ts = time_stamp();
|
||
|
||
/* Check if this warning occurs inside a catch. */
|
||
inside_catch = MY_FALSE;
|
||
|
||
{
|
||
rt_context_t *rt;
|
||
|
||
for ( rt = rt_context
|
||
; !ERROR_RECOVERY_CONTEXT(rt->type)
|
||
; rt = rt->last) NOOP;
|
||
|
||
inside_catch = (rt->type >= ERROR_RECOVERY_CATCH);
|
||
}
|
||
|
||
va_start(va, fmt);
|
||
|
||
/* Make fmt sane */
|
||
fmt = limit_error_format(fixed_fmt, sizeof(fixed_fmt), fmt);
|
||
|
||
/* Check the current object */
|
||
curobj = NULL;
|
||
if (current_object != NULL
|
||
&& current_object != &dummy_current_object_for_loads)
|
||
curobj = current_object;
|
||
|
||
if (curobj)
|
||
assign_eval_cost();
|
||
|
||
/* Generate the error message */
|
||
vsprintf(msg_buf, fmt, va);
|
||
va_end(va);
|
||
|
||
debug_message("%s ", ts);
|
||
debug_message("%s", msg_buf);
|
||
|
||
/* If we have a current_object, determine the program location
|
||
* of the fault.
|
||
*/
|
||
if (curobj)
|
||
{
|
||
line_number = get_line_number_if_any(&file);
|
||
debug_message("%s program: %s, object: %s line %"PRIdMPINT"\n"
|
||
, ts, get_txt(file), get_txt(curobj->name)
|
||
, line_number);
|
||
}
|
||
|
||
fflush(stdout);
|
||
|
||
if (num_warning < 3)
|
||
{
|
||
/* Call master::runtime_warning().
|
||
*/
|
||
|
||
object_t * save_cmd = command_giver;
|
||
|
||
put_c_string(++inter_sp, msg_buf);
|
||
if (curobj)
|
||
{
|
||
if (compat_mode)
|
||
push_ref_string(inter_sp, curobj->name);
|
||
else
|
||
push_string(inter_sp, add_slash(curobj->name));
|
||
}
|
||
else
|
||
push_number(inter_sp, 0);
|
||
if (file)
|
||
push_ref_string(inter_sp, file);
|
||
else
|
||
push_number(inter_sp, 0);
|
||
push_number(inter_sp, line_number);
|
||
push_number(inter_sp, inside_catch ? 1 : 0);
|
||
|
||
apply_master(STR_WARNING, 5);
|
||
command_giver = save_cmd;
|
||
}
|
||
else
|
||
{
|
||
if (file)
|
||
free_mstring(file);
|
||
errorf("Too many nested warnings.\n");
|
||
}
|
||
|
||
if (file)
|
||
free_mstring(file);
|
||
|
||
num_warning--;
|
||
} /* warnf() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
parse_error (Bool warning, const char *error_file, int line, const char *what
|
||
, const char *context)
|
||
|
||
/* The compiler found an error <what> (<warning> is FALSE) resp.
|
||
* a warning <what> (<warning> is TRUE) while compiling <line> of
|
||
* file <error_file>. The context of the error location is <context>.
|
||
*
|
||
* Log the error by calling master:log_error() (but do not reload
|
||
* the master if not existing - the compiler is busy).
|
||
*/
|
||
|
||
{
|
||
char buff[500];
|
||
|
||
if (error_file == NULL)
|
||
return;
|
||
if (strlen(what) + strlen(error_file) > sizeof buff - 100)
|
||
what = "...[too long error message]...";
|
||
if (strlen(what) + strlen(error_file) > sizeof buff - 100)
|
||
error_file = "...[too long filename]...";
|
||
sprintf(buff, "%s line %d%s: %s\n", error_file, line, context, what);
|
||
|
||
/* Don't call the master if it isn't loaded! */
|
||
if (master_ob && !(master_ob->flags & O_DESTRUCTED) )
|
||
{
|
||
push_c_string(inter_sp, error_file);
|
||
push_c_string(inter_sp, buff);
|
||
push_number(inter_sp, warning ? 1 : 0);
|
||
apply_master(STR_LOG_ERROR, 3);
|
||
}
|
||
} /* parse_error() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
throw_error (svalue_t *v)
|
||
|
||
/* The efun throw(). We have to save the message <v> in the
|
||
* error context and then do the proper longjmp. <v> is freed.
|
||
*/
|
||
|
||
{
|
||
unroll_context_stack();
|
||
if (rt_context->type >= ERROR_RECOVERY_CATCH)
|
||
{
|
||
transfer_error_message(v, rt_context);
|
||
longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
|
||
fatal("Throw_error failed!");
|
||
}
|
||
free_svalue(v);
|
||
errorf("Throw with no catch.\n");
|
||
} /* throw_error() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
set_svalue_user (svalue_t *svp, object_t *owner)
|
||
|
||
/* Set the owner of <svp> to object <owner>, if the svalue knows of
|
||
* this concept. This may cause a recursive call to this function again.
|
||
*/
|
||
|
||
{
|
||
switch(svp->type)
|
||
{
|
||
case T_POINTER:
|
||
case T_QUOTED_ARRAY:
|
||
set_vector_user(svp->u.vec, owner);
|
||
break;
|
||
case T_MAPPING:
|
||
{
|
||
set_mapping_user(svp->u.map, owner);
|
||
break;
|
||
}
|
||
case T_CLOSURE:
|
||
{
|
||
set_closure_user(svp, owner);
|
||
}
|
||
}
|
||
} /* set_svalue_user() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static void
|
||
give_uid_error_handler (svalue_t *arg)
|
||
|
||
/* Error handler for give_uid_to_object(), called automatically when
|
||
* the stack is cleant up during the error handling.
|
||
* <arg> is a (struct give_uid_error_context*), the action is to destruct
|
||
* the object.
|
||
*/
|
||
|
||
{
|
||
struct give_uid_error_context *ecp;
|
||
object_t *ob;
|
||
|
||
ecp = (struct give_uid_error_context *)arg;
|
||
ob = ecp->new_object;
|
||
xfree(ecp);
|
||
|
||
if (ob)
|
||
{
|
||
destruct(ob);
|
||
}
|
||
} /* give_uid_error_handler() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static void
|
||
push_give_uid_error_context (object_t *ob)
|
||
|
||
/* Object <ob> will be given its uids. Push an error handler onto the
|
||
* interpreter stack which will clean up <ob> in case of an error.
|
||
*/
|
||
|
||
{
|
||
struct give_uid_error_context *ecp;
|
||
|
||
ecp = xalloc(sizeof *ecp);
|
||
if (!ecp)
|
||
{
|
||
destruct(ob);
|
||
errorf("Out of memory (%zu bytes) for new object '%s' uids\n"
|
||
, sizeof(*ecp), get_txt(ob->name));
|
||
}
|
||
ecp->new_object = ob;
|
||
push_error_handler(give_uid_error_handler, &(ecp->head));
|
||
} /* push_give_uid_error_context() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static Bool
|
||
give_uid_to_object (object_t *ob, int hook, int numarg)
|
||
|
||
/* Object <ob> was just created - call the driver_hook <hook> with <numarg>
|
||
* arguments to give it its uid and euid.
|
||
* Return TRUE on success - on failure, destruct <ob>ject and raise
|
||
* an error; return FALSE in the unlikely case that errorf() does return.
|
||
*/
|
||
|
||
{
|
||
lambda_t *l;
|
||
char *err, errtxt[1024];
|
||
svalue_t arg, *ret;
|
||
|
||
ob->user = &default_wizlist_entry; /* Default uid */
|
||
|
||
if ( NULL != (l = driver_hook[hook].u.lambda) )
|
||
{
|
||
if (driver_hook[hook].x.closure_type == CLOSURE_LAMBDA)
|
||
{
|
||
free_object(l->ob, "give_uid_to_object");
|
||
l->ob = ref_object(ob, "give_uid_to_object");
|
||
}
|
||
call_lambda(&driver_hook[hook], numarg);
|
||
ret = inter_sp;
|
||
xfree(ret[-1].u.lvalue); /* free error context */
|
||
|
||
if (ret->type == T_STRING)
|
||
{
|
||
ob->user = add_name(ret->u.str);
|
||
ob->eff_user = ob->user;
|
||
pop_stack(); /* deallocate result */
|
||
inter_sp--; /* skip error context */
|
||
return MY_TRUE;
|
||
}
|
||
else if (ret->type == T_POINTER && VEC_SIZE(ret->u.vec) == 2
|
||
&& ( ret->u.vec->item[0].type == T_STRING
|
||
|| (!strict_euids && ret->u.vec->item[0].u.number)
|
||
)
|
||
)
|
||
{
|
||
ret = ret->u.vec->item;
|
||
ob->user = ret[0].type != T_STRING
|
||
? &default_wizlist_entry
|
||
: add_name(ret[0].u.str);
|
||
ob->eff_user = ret[1].type != T_STRING
|
||
? 0
|
||
: add_name(ret[1].u.str);
|
||
pop_stack();
|
||
inter_sp--;
|
||
return MY_TRUE;
|
||
}
|
||
else if (!strict_euids && ret->type == T_NUMBER && ret->u.number)
|
||
{
|
||
ob->user = &default_wizlist_entry;
|
||
ob->eff_user = NULL;
|
||
pop_stack();
|
||
inter_sp--;
|
||
return MY_TRUE;
|
||
}
|
||
else
|
||
{
|
||
pop_stack(); /* deallocate result */
|
||
sprintf(errtxt, "Object '%.900s' illegal to load (no uid).\n"
|
||
, get_txt(ob->name));
|
||
err = errtxt;
|
||
}
|
||
}
|
||
else
|
||
{
|
||
do pop_stack(); while (--numarg); /* deallocate arguments */
|
||
xfree(inter_sp->u.lvalue);
|
||
err = "closure to set uid not initialized!\n";
|
||
}
|
||
|
||
inter_sp--; /* skip error context */
|
||
|
||
if (master_ob == NULL)
|
||
{
|
||
/* Only for the master object. */
|
||
ob->user = add_name(STR_NONAME);
|
||
ob->eff_user = NULL;
|
||
return MY_TRUE;
|
||
}
|
||
|
||
ob->user = add_name(STR_NONAME);
|
||
ob->eff_user = ob->user;
|
||
put_object(&arg, ob);
|
||
destruct_object(&arg);
|
||
errorf(err);
|
||
/* NOTREACHED */
|
||
return MY_FALSE;
|
||
} /* give_uid_to_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
const char *
|
||
make_name_sane (const char *pName, Bool addSlash)
|
||
|
||
/* Make a given object name sane.
|
||
*
|
||
* The function removes leading '/' (if addSlash is true, all but one leading
|
||
* '/' are removed), a trailing '.c', and folds consecutive
|
||
* '/' into just one '/'. The '.c' removal does not work when given
|
||
* clone object names (i.e. names ending in '#<number>').
|
||
*
|
||
* The function returns a pointer to a static(!) buffer with the cleant
|
||
* up name, or NULL if the given name already was sane.
|
||
*/
|
||
|
||
{
|
||
static char buf[MAXPATHLEN+1];
|
||
const char *from = pName;
|
||
char *to;
|
||
short bDiffers = MY_FALSE;
|
||
|
||
to = buf;
|
||
|
||
/* Skip leading '/' */
|
||
if (!addSlash)
|
||
{
|
||
while (*from == '/') {
|
||
bDiffers = MY_TRUE;
|
||
from++;
|
||
}
|
||
}
|
||
else
|
||
{
|
||
*to++ = '/';
|
||
if (*from != '/')
|
||
bDiffers = MY_TRUE;
|
||
else
|
||
{
|
||
from++;
|
||
while (*from == '/') {
|
||
bDiffers = MY_TRUE;
|
||
from++;
|
||
}
|
||
}
|
||
}
|
||
/* addSlash or not: from now points to the first non-'/' */
|
||
|
||
/* Copy the name into buf, doing the other operations */
|
||
for (; '\0' != *from && (size_t)(to - buf) < sizeof(buf)
|
||
; from++, to++)
|
||
{
|
||
if ('/' == *from)
|
||
{
|
||
*to = '/';
|
||
while ('/' == *from) {
|
||
from++;
|
||
bDiffers = MY_TRUE;
|
||
}
|
||
|
||
from--;
|
||
}
|
||
else if ('.' == *from && 'c' == *(from+1) && '\0' == *(from+2))
|
||
{
|
||
bDiffers = MY_TRUE;
|
||
break;
|
||
}
|
||
else
|
||
*to = *from;
|
||
}
|
||
*to = '\0';
|
||
|
||
if (!bDiffers)
|
||
return NULL;
|
||
|
||
return (const char *)buf;
|
||
} /* make_name_sane() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
Bool
|
||
check_no_parentdirs (const char *path)
|
||
|
||
/* Check that there are no '/../' constructs in the path.
|
||
* Return TRUE if there aren't.
|
||
*/
|
||
|
||
{
|
||
char *p;
|
||
|
||
if (path == NULL)
|
||
return MY_FALSE;
|
||
|
||
for (p = strchr(path, '.'); p; p = strchr(p+1, '.'))
|
||
{
|
||
if (p[1] != '.')
|
||
continue;
|
||
if ((p[2] == '\0' || p[2] == '/')
|
||
&& (p == path || p[-1] == '/')
|
||
)
|
||
return MY_FALSE;
|
||
|
||
/* Skip the next '.' as it's safe to do so */
|
||
p++;
|
||
}
|
||
return MY_TRUE;
|
||
} /* check_no_parentdirs() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
Bool
|
||
legal_path (const char *path)
|
||
|
||
/* Check that <path> is a legal relative path. This means no spaces
|
||
* and no '/../' are allowed.
|
||
* TODO: This should go into a 'files' module.
|
||
*/
|
||
{
|
||
if (path == NULL
|
||
|| (!allow_filename_spaces && strchr(path, ' '))
|
||
|| path[0] == '/')
|
||
return MY_FALSE;
|
||
|
||
#ifdef MSDOS_FS
|
||
{
|
||
const char *name;
|
||
|
||
if (strchr(path,'\\'))
|
||
return MY_FALSE; /* better safe than sorry ... */
|
||
if (strchr(path,':'))
|
||
return MY_FALSE; /* \B: is okay for DOS .. *sigh* */
|
||
name = strrchr(path,'/');
|
||
if (NULL != name)
|
||
name++;
|
||
else
|
||
name = path;
|
||
if (!strcasecmp(name,"NUL")
|
||
|| !strcasecmp(name,"CON")
|
||
|| !strcasecmp(name,"PRN")
|
||
|| !strcasecmp(name,"AUX")
|
||
|| !strcasecmp(name,"COM1")
|
||
|| !strcasecmp(name,"COM2")
|
||
|| !strcasecmp(name,"COM3")
|
||
|| !strcasecmp(name,"COM4")
|
||
|| !strcasecmp(name,"LPT1")
|
||
|| !strcasecmp(name,"LPT2")
|
||
|| !strcasecmp(name,"LPT3")
|
||
|| !strcasecmp(name,"LPT4")
|
||
)
|
||
return MY_FALSE;
|
||
}
|
||
#endif
|
||
|
||
return check_no_parentdirs(path);
|
||
} /* legal_path() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static void load_object_error(const char *msg, const char *name, namechain_t *chain) NORETURN;
|
||
|
||
static void
|
||
load_object_error(const char *msg, const char *name, namechain_t *chain)
|
||
|
||
/* Generate a compilation error message <msg>. If <name> is not NULL,
|
||
* ": '<name>'" is appended to the message. If <chain> is not NULL,
|
||
* " (inherited by <chain...>)" is appended to the message.
|
||
* The message is then printed to stderr and an errorf() with it is thrown.
|
||
*/
|
||
|
||
{
|
||
strbuf_t sbuf;
|
||
namechain_t *ptr;
|
||
char * buf;
|
||
|
||
strbuf_zero(&sbuf);
|
||
|
||
strbuf_add(&sbuf, msg);
|
||
if (name != NULL)
|
||
{
|
||
strbuf_add(&sbuf, ": '");
|
||
strbuf_add(&sbuf, name);
|
||
strbuf_add(&sbuf, "'");
|
||
}
|
||
|
||
if (chain != NULL)
|
||
{
|
||
strbuf_add(&sbuf, " (inherited");
|
||
for (ptr = chain; ptr != NULL; ptr = ptr->prev)
|
||
{
|
||
strbuf_add(&sbuf, " by '");
|
||
strbuf_add(&sbuf, ptr->name);
|
||
strbuf_add(&sbuf, "'");
|
||
}
|
||
strbuf_add(&sbuf, ")");
|
||
}
|
||
|
||
strbuf_add(&sbuf, ".\n");
|
||
|
||
/* Make a local copy of the message so as not to leak memory */
|
||
buf = alloca(strbuf_length(&sbuf)+1);
|
||
if (!buf)
|
||
errorf("Out of stack memory (%zu bytes)\n"
|
||
, strlen(sbuf.buf)+1);
|
||
strbuf_copy(&sbuf, buf);
|
||
strbuf_free(&sbuf);
|
||
|
||
fprintf(stderr, "%s %s", time_stamp(), buf);
|
||
errorf("%.*s", MIN(ERROR_BUF_LEN - 200, (int)strlen(buf)), buf);
|
||
} /* load_object_error() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
#define MAX_LOAD_DEPTH 60 /* Make this a configurable constant */
|
||
|
||
static object_t *
|
||
load_object (const char *lname, Bool create_super, int depth
|
||
, Bool isMasterObj, namechain_t *chain)
|
||
|
||
/* Load (compile) an object blueprint from the file <lname>.
|
||
* <create_super> is true if the object has to be
|
||
* initialized with CREATE_SUPER, and false if CREATE_OB is to be used.
|
||
* <depth> is the current recursive load depth and is checked
|
||
* against MAX_LOAD_DEPTH.
|
||
* <isMasterObj> is TRUE if the top-level object to be compiled is the master
|
||
* object.
|
||
* <chain> is the pointer to the calling frame's namechain structure.
|
||
*
|
||
* If the object can't be loaded because it inherits some other unloaded
|
||
* object, call load_object() recursively to load the inherited object, then
|
||
* try to load the original object again. This is done in a loop so that
|
||
* eventually all missing inherits are loaded.
|
||
*
|
||
* The name <lname> must be sane object name, and can be a clone name.
|
||
*
|
||
* If there is no source file <lname>.c, the function calls
|
||
* master:compile_object() in case it is a virtual object.
|
||
*
|
||
* Result is the pointer to the loaded object, or NULL on failure.
|
||
*/
|
||
|
||
{
|
||
int fd;
|
||
object_t *ob;
|
||
object_t *save_command_giver = command_giver;
|
||
long i;
|
||
struct stat c_st;
|
||
size_t name_length;
|
||
char *name; /* Copy of <lname> */
|
||
char *fname; /* Filename for <name> */
|
||
program_t *prog;
|
||
namechain_t nlink;
|
||
|
||
#ifdef DEBUG
|
||
if ('/' == lname[0])
|
||
fatal("Improper filename '%s' passed to load_object()\n", lname);
|
||
#endif
|
||
|
||
/* Empty lnames may lead to a driver crash in enter_object_hash() if there
|
||
* exists a file '.c' in the root of the mudlib.
|
||
*/
|
||
name_length = strlen(lname);
|
||
|
||
if (name_length < 1) {
|
||
load_object_error("Illegal file to load (empty filename)", lname, chain);
|
||
/* NOTREACHED */
|
||
}
|
||
|
||
/* It could be that the passed filename is one of an already loaded
|
||
* object. In that case, simply return that object.
|
||
*/
|
||
ob = lookup_object_hash_str((char *)lname);
|
||
if (ob)
|
||
{
|
||
return ob;
|
||
}
|
||
|
||
/* We need two copies of <lname>: one to construct the filename in,
|
||
* the second because lname might be a buffer which is deleted
|
||
* during the compilation process.
|
||
* The memory is allocated in one chunk for both strings and an error
|
||
* handler is pushed on the stack (additionally is needed: memory for '/'
|
||
* and '\0’ (sizeof("/")) and '/', '\0', '.' and 'c' (sizeof("/.c"))).
|
||
*/
|
||
name = xalloc_with_error_handler(2 * name_length + sizeof("/") +
|
||
sizeof("/.c"));
|
||
fname = name + name_length + sizeof("/") + 1;
|
||
if (!name)
|
||
errorf("Out of memory (%zu bytes) in load_object() for temporary name "
|
||
"buffers.\n", 2*name_length + sizeof("/") + sizeof("/.c"));
|
||
|
||
if (!compat_mode)
|
||
*name++ = '/'; /* Add and hide a leading '/' */
|
||
strcpy(name, lname);
|
||
strcpy(fname, lname);
|
||
|
||
nlink.name = name;
|
||
nlink.prev = chain;
|
||
|
||
if (strict_euids && current_object && current_object->eff_user == 0
|
||
&& current_object->name)
|
||
errorf("Can't load objects when no effective user.\n");
|
||
|
||
if (master_ob && master_ob->flags & O_DESTRUCTED)
|
||
{
|
||
/* The master has been destructed, and it has not been noticed yet.
|
||
* Reload it, because it can't be done inside of yyparse.
|
||
* assert_master_ob_loaded() will clear master_ob while reloading is
|
||
* in progress, thus preventing a fatal recursion.
|
||
*/
|
||
assert_master_ob_loaded();
|
||
/* has the object been loaded by assert_master_ob_loaded ? */
|
||
if ( NULL != (ob = find_object_str(name)) )
|
||
{
|
||
#ifdef USE_SWAP
|
||
if (ob->flags & O_SWAPPED && load_ob_from_swap(ob) < 0)
|
||
/* The master has swapped this object and used up most
|
||
* memory... strange, but thinkable
|
||
*/
|
||
errorf("Out of memory: unswap object '%s'\n", get_txt(ob->name));
|
||
#endif
|
||
pop_stack(); /* free error handler */
|
||
return ob;
|
||
}
|
||
}
|
||
|
||
/* Check if the name follows the "name#number" pattern */
|
||
{
|
||
char c;
|
||
char *p;
|
||
|
||
i = name_length;
|
||
p = name+name_length;
|
||
while (--i > 0) {
|
||
/* isdigit would need to check isascii first... */
|
||
if ( (c = *--p) < '0' || c > '9' ) {
|
||
if (c == '#' && name_length - i > 1)
|
||
{
|
||
load_object_error("Illegal file to load", name, chain);
|
||
/* NOTREACHED */
|
||
}
|
||
break;
|
||
}
|
||
}
|
||
}
|
||
|
||
/* Check if we were already trying to compile this object */
|
||
if (chain != NULL)
|
||
{
|
||
namechain_t * ptr;
|
||
|
||
for (ptr = chain; ptr != NULL; ptr = ptr->prev)
|
||
{
|
||
if (!strcmp(name, ptr->name))
|
||
load_object_error("Recursive inherit", name, chain);
|
||
}
|
||
}
|
||
|
||
/* Check that the c-file exists.
|
||
*/
|
||
(void)strcpy(fname+name_length, ".c");
|
||
if (ixstat(fname, &c_st) == -1)
|
||
{
|
||
/* The file does not exist - maybe it's a virtual object */
|
||
|
||
svalue_t *svp;
|
||
|
||
push_c_string(inter_sp, fname);
|
||
svp = apply_master(STR_COMPILE_OBJECT, 1);
|
||
if (svp && svp->type == T_OBJECT)
|
||
{
|
||
/* We got an object from the call, but is it what it
|
||
* claims to be?
|
||
*/
|
||
if ( NULL != (ob = lookup_object_hash_str(name)) )
|
||
{
|
||
/* An object for <name> magically appeared - is it
|
||
* the one we received?
|
||
*/
|
||
if (ob == svp->u.ob)
|
||
{
|
||
/* If this object is a clone, clear the clone flag
|
||
* but mark it as replaced.
|
||
*/
|
||
if (ob->flags & O_CLONE)
|
||
{
|
||
ob->flags &= ~O_CLONE;
|
||
ob->flags |= O_REPLACED;
|
||
}
|
||
pop_stack(); /* free error handler */
|
||
return ob;
|
||
}
|
||
}
|
||
else if (ob != master_ob)
|
||
{
|
||
/* Rename the object we got to the name it
|
||
* is supposed to have.
|
||
*/
|
||
ob = svp->u.ob;
|
||
remove_object_hash(ob);
|
||
free_mstring(ob->name);
|
||
ob->name = new_mstring(name);
|
||
enter_object_hash(ob);
|
||
|
||
/* If this object is a clone, clear the clone flag
|
||
* but mark it as replaced.
|
||
*/
|
||
if (ob->flags & O_CLONE)
|
||
{
|
||
ob->flags &= ~O_CLONE;
|
||
ob->flags |= O_REPLACED;
|
||
}
|
||
pop_stack(); /* free error handler */
|
||
return ob;
|
||
}
|
||
fname[name_length] = '.';
|
||
}
|
||
load_object_error("Failed to load file", name, chain);
|
||
/* NOTREACHED */
|
||
return NULL;
|
||
}
|
||
|
||
/* Check if it's a legal name.
|
||
*/
|
||
if (!legal_path(fname))
|
||
{
|
||
load_object_error("Illegal pathname", fname, chain);
|
||
/* NOTREACHED */
|
||
return NULL;
|
||
}
|
||
|
||
/* The compilation loop. It will run until either <name> is loaded
|
||
* or an error occurs. If the compilation is aborted because an
|
||
* inherited object was not found, that object is loaded in a
|
||
* recursive call, then the loop will try again on the original
|
||
* object.
|
||
*/
|
||
|
||
while (MY_TRUE)
|
||
{
|
||
/* This can happen after loading an inherited object: */
|
||
ob = lookup_object_hash_str((char *)name);
|
||
if (ob)
|
||
{
|
||
pop_stack(); /* free error handler */
|
||
return ob;
|
||
}
|
||
|
||
if (comp_flag)
|
||
fprintf(stderr, "%s compiling %s ...", time_stamp(), fname);
|
||
|
||
if (current_loc.file)
|
||
{
|
||
errorf("Can't load '%s': compiler is busy with '%s'.\n"
|
||
, name, current_loc.file->name);
|
||
}
|
||
|
||
fd = ixopen(fname, O_RDONLY | O_BINARY);
|
||
if (fd <= 0)
|
||
{
|
||
perror(fname);
|
||
errorf("Could not read the file.\n");
|
||
}
|
||
FCOUNT_COMP(fname);
|
||
|
||
/* The file name is needed before compile_file(), in case there is
|
||
* an initial 'line too long' error.
|
||
*/
|
||
compile_file(fd, fname, isMasterObj);
|
||
if (comp_flag)
|
||
{
|
||
if (NULL == inherit_file)
|
||
fprintf(stderr, " done\n");
|
||
else
|
||
{
|
||
fprintf(stderr, " needs inherit\n");
|
||
}
|
||
}
|
||
|
||
update_compile_av(total_lines);
|
||
total_lines = 0;
|
||
(void)close(fd);
|
||
|
||
/* If there is no inherited file to compile, we can
|
||
* end the loop here.
|
||
*/
|
||
if (NULL == inherit_file)
|
||
break;
|
||
|
||
/* This object wants to inherit an unloaded object. We discard
|
||
* current object, load the object to be inherited and reload
|
||
* the current object again. The global variable "inherit_file"
|
||
* was set by lang.y to point to a file name.
|
||
*/
|
||
{
|
||
char * pInherited;
|
||
const char * tmp;
|
||
|
||
tmp = make_name_sane(get_txt(inherit_file), MY_FALSE);
|
||
if (!tmp)
|
||
{
|
||
pInherited = get_txt(inherit_file);
|
||
}
|
||
else
|
||
{
|
||
pInherited = alloca(strlen(tmp)+1);
|
||
strcpy(pInherited, tmp);
|
||
}
|
||
|
||
push_string(inter_sp, inherit_file);
|
||
/* Automagic freeing in case of errors */
|
||
inherit_file = NULL;
|
||
|
||
/* Now that the inherit_file-string will be freed in case
|
||
* of an error, we can check if there were other errors
|
||
* besides the missing inherit.
|
||
*/
|
||
if (num_parse_error > 0)
|
||
{
|
||
load_object_error("Error in loading object", name, chain);
|
||
}
|
||
|
||
if (strcmp(pInherited, name) == 0)
|
||
{
|
||
errorf("Illegal to inherit self.\n");
|
||
}
|
||
|
||
if (depth >= MAX_LOAD_DEPTH)
|
||
{
|
||
load_object_error("Too deep inheritance", name, chain);
|
||
}
|
||
|
||
ob = load_object(pInherited, MY_TRUE, depth+1, isMasterObj, &nlink);
|
||
free_mstring(inter_sp->u.str);
|
||
inter_sp--;
|
||
if (!ob || ob->flags & O_DESTRUCTED)
|
||
{
|
||
load_object_error("Error in loading object "
|
||
"(inheritance failed)\n", name, chain);
|
||
}
|
||
} /* handling of inherit_file */
|
||
} /* while() - compilation loop */
|
||
|
||
/* Did the compilation succeed? */
|
||
if (num_parse_error > 0)
|
||
{
|
||
load_object_error("Error in loading object", name, chain);
|
||
}
|
||
|
||
/* We got the program. Now create the blueprint to hold it.
|
||
*/
|
||
|
||
if (NULL != (ob = lookup_object_hash_str(name)))
|
||
{
|
||
/* The object magically appeared!
|
||
* This can happen if rename_object() is used carelessly
|
||
* in the mudlib handler for compiler warnings.
|
||
*/
|
||
free_prog(compiled_prog, MY_TRUE);
|
||
load_object_error("Object appeared while it was compiled"
|
||
, name, chain);
|
||
/* NOTREACHED */
|
||
return NULL;
|
||
}
|
||
|
||
prog = compiled_prog;
|
||
|
||
ob = get_empty_object(prog->num_variables);
|
||
|
||
if (!ob)
|
||
errorf("Out of memory for new object '%s'\n", name);
|
||
|
||
ob->name = new_mstring(name);
|
||
#ifdef CHECK_OBJECT_STAT
|
||
if (check_object_stat)
|
||
{
|
||
fprintf(stderr, "DEBUG: OSTAT: (%ld:%ld) load( %p '%s') name: %zu -> (%ld:%ld)\n"
|
||
, tot_alloc_object, tot_alloc_object_size, ob, ob->name ? get_txt(ob->name) : "<null>"
|
||
, mstrsize(ob->name)
|
||
, tot_alloc_object
|
||
, tot_alloc_object_size + (mstrsize(ob->name))
|
||
);
|
||
}
|
||
#endif
|
||
tot_alloc_object_size += mstrsize(ob->name);
|
||
/* Tabling this unique string is of not much use.
|
||
* Note that the string must be valid for the ref_object()
|
||
* below to work in debugging mode.
|
||
*/
|
||
|
||
prog->blueprint = ref_object(ob, "load_object: blueprint reference");
|
||
|
||
if (!compat_mode)
|
||
name--; /* Make the leading '/' visible again */
|
||
ob->load_name = new_tabled(name); /* but here it is */
|
||
ob->prog = prog;
|
||
ob->ticks = ob->gigaticks = 0;
|
||
ob->next_all = obj_list;
|
||
ob->prev_all = NULL;
|
||
if (obj_list)
|
||
obj_list->prev_all = ob;
|
||
obj_list = ob;
|
||
if (!obj_list_end)
|
||
obj_list_end = ob;
|
||
num_listed_objs++;
|
||
enter_object_hash(ob); /* add name to fast object lookup table */
|
||
|
||
/* Give the object its uids */
|
||
push_give_uid_error_context(ob);
|
||
push_ref_string(inter_sp, ob->name);
|
||
if (give_uid_to_object(ob, H_LOAD_UIDS, 1))
|
||
{
|
||
/* The object has an uid - now we can update the .user
|
||
* of its initializers.
|
||
*/
|
||
svalue_t *svp;
|
||
int j;
|
||
object_t *save_current;
|
||
|
||
save_current = current_object;
|
||
current_object = ob; /* just in case */
|
||
svp = ob->variables;
|
||
for (j = ob->prog->num_variables; --j >= 0; svp++)
|
||
{
|
||
if (svp->type == T_NUMBER)
|
||
continue;
|
||
set_svalue_user(svp, ob);
|
||
}
|
||
|
||
if (save_current == &dummy_current_object_for_loads)
|
||
{
|
||
/* The master object is loaded with no current object */
|
||
current_object = NULL;
|
||
init_object_variables(ob, NULL);
|
||
reset_object(ob, create_super ? H_CREATE_SUPER : H_CREATE_OB);
|
||
|
||
/* If the master inherits anything -Ugh- we have to have
|
||
* some object to attribute initialized variables to.
|
||
*/
|
||
current_object = save_current;
|
||
}
|
||
else
|
||
{
|
||
current_object = save_current;
|
||
init_object_variables(ob, NULL);
|
||
reset_object(ob, create_super ? H_CREATE_SUPER : H_CREATE_OB);
|
||
}
|
||
}
|
||
|
||
if ( !(ob->flags & O_DESTRUCTED))
|
||
ob->flags |= O_WILL_CLEAN_UP;
|
||
|
||
/* free the error handler with the buffer for name and fname. */
|
||
pop_stack();
|
||
|
||
/* Restore the command giver */
|
||
command_giver = check_object(save_command_giver);
|
||
|
||
#ifdef USE_LDMUD_COMPATIBILITY
|
||
if (d_flag > 1 && ob)
|
||
{
|
||
/* Isn't this redundant with the -c flag!? */
|
||
debug_message("%s --%s loaded\n", time_stamp(), get_txt(ob->name));
|
||
}
|
||
#endif
|
||
|
||
#if 0 && defined(CHECK_OBJECT_REF)
|
||
if (strchr(get_txt(ob->name), '#') == NULL)
|
||
printf("DEBUG: new_object(%p '%s') ref %"PRIdPINT" flags %x\n"
|
||
, ob, get_txt(ob->name), ob->ref, ob->flags);
|
||
#endif
|
||
return ob;
|
||
} /* load_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static string_t *
|
||
make_new_name (string_t *str)
|
||
|
||
/* <str> is a basic object name - generate a clone name "<str>#<num>"
|
||
* and return it. The result will be an untabled string with one reference.
|
||
*
|
||
* The number is guaranteed to be unique in combination with this name.
|
||
*/
|
||
|
||
{
|
||
static unsigned long clone_id_number = 0;
|
||
/* The next number to use for a clone name */
|
||
|
||
static int test_conflict = MY_FALSE;
|
||
/* TRUE if the generated clone name has to be tested for uniqueness.
|
||
* This is not the case before clone_id_number wraps around the
|
||
* first time.
|
||
*/
|
||
|
||
string_t *p;
|
||
char buff[40];
|
||
|
||
str = del_slash(str);
|
||
|
||
for (;;)
|
||
{
|
||
/* Generate the clone name */
|
||
(void)sprintf(buff, "#%lu", clone_id_number);
|
||
p = mstr_add_txt(str, buff, strlen(buff));
|
||
|
||
clone_id_number++;
|
||
if (clone_id_number == 0) /* Wrap around */
|
||
test_conflict = MY_TRUE;
|
||
|
||
if (!test_conflict || !find_object(p))
|
||
{
|
||
free_mstring(str);
|
||
return p;
|
||
}
|
||
|
||
/* The name was already taken */
|
||
free_mstring(p);
|
||
}
|
||
} /* make_new_name() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static object_t *
|
||
clone_object (string_t *str1)
|
||
|
||
/* Create a clone of the object named <str1>, which may be a clone itself.
|
||
* On success, return the new object, otherwise NULL.
|
||
*/
|
||
|
||
{
|
||
object_t *ob, *new_ob;
|
||
object_t *save_command_giver = command_giver;
|
||
string_t *name;
|
||
|
||
if (strict_euids && current_object && current_object->eff_user == NULL)
|
||
errorf("Illegal to call clone_object() with effective user 0\n");
|
||
|
||
ob = get_object(str1);
|
||
|
||
/* If the object self-destructed...
|
||
*/
|
||
if (ob == NULL)
|
||
return NULL;
|
||
|
||
/* If ob is a clone, try finding the blueprint first via the object's
|
||
* program, then via the load_name.
|
||
*/
|
||
if (ob->flags & O_CLONE)
|
||
{
|
||
object_t *bp = NULL;
|
||
|
||
/* If the object's program hasn't been replaced, it most likely
|
||
* contains a pointer to the blueprint we're looking for.
|
||
*/
|
||
if (!(ob->flags & O_REPLACED))
|
||
{
|
||
bp = ob->prog->blueprint;
|
||
if (bp && (bp->flags & O_DESTRUCTED))
|
||
{
|
||
free_object(bp, "clone_object");
|
||
bp = ob->prog->blueprint = NULL;
|
||
}
|
||
}
|
||
|
||
/* Fallback: find/load the blueprint by the load_name */
|
||
if (!bp)
|
||
bp = get_object(ob->load_name);
|
||
if (bp)
|
||
ob = bp;
|
||
}
|
||
|
||
#ifdef USE_INVENTORIES
|
||
if (ob->super)
|
||
errorf("Cloning a bad object: '%s' is contained in '%s'.\n"
|
||
, get_txt(ob->name), get_txt(ob->super->name));
|
||
#endif
|
||
|
||
name = ob->name;
|
||
|
||
/* If the ob is a clone, we have to test if its name is something
|
||
* illegal like 'foobar#34'. In that case, we have to use the
|
||
* load_name as template.
|
||
*/
|
||
if (ob->flags & O_CLONE)
|
||
{
|
||
char c;
|
||
char *p;
|
||
mp_int name_length, i;
|
||
|
||
name_length = mstrsize(name);
|
||
i = name_length;
|
||
p = get_txt(ob->name)+name_length;
|
||
while (--i > 0) {
|
||
/* isdigit would need to check isascii first... */
|
||
if ( (c = *--p) < '0' || c > '9' )
|
||
{
|
||
if (c == '#' && name_length - i > 1)
|
||
{
|
||
/* Well, unusable name format - use the load_name */
|
||
name = ob->load_name;
|
||
}
|
||
break;
|
||
}
|
||
}
|
||
}
|
||
|
||
#ifdef USE_SWAP
|
||
if ((ob->flags & O_SWAPPED) && load_ob_from_swap(ob) < 0)
|
||
errorf("Out of memory: unswap object '%s'\n", get_txt(ob->name));
|
||
#endif
|
||
|
||
if (ob->prog->flags & P_NO_CLONE)
|
||
errorf("Cloning a bad object: '%s' sets '#pragma no_clone'.\n"
|
||
, get_txt(ob->name));
|
||
|
||
ob->time_of_ref = current_time;
|
||
|
||
/* We do not want the heart beat to be running for unused copied objects */
|
||
|
||
if (!(ob->flags & O_CLONE) && ob->flags & O_HEART_BEAT)
|
||
set_heart_beat(ob, MY_FALSE);
|
||
|
||
/* Got the blueprint - now get a new object */
|
||
|
||
new_ob = get_empty_object(ob->prog->num_variables);
|
||
if (!new_ob)
|
||
errorf("Out of memory for new clone '%s'\n", get_txt(name));
|
||
|
||
new_ob->name = make_new_name(name);
|
||
|
||
#ifdef CHECK_OBJECT_STAT
|
||
if (check_object_stat)
|
||
{
|
||
fprintf(stderr, "DEBUG: OSTAT: (%ld:%ld) clone( %p '%s') name: %zu -> (%ld:%ld)\n"
|
||
, tot_alloc_object, tot_alloc_object_size, new_ob, new_ob->name ? get_txt(new_ob->name) : "<null>"
|
||
, mstrsize(new_ob->name)
|
||
, tot_alloc_object
|
||
, tot_alloc_object_size + (mstrsize(new_ob->name))
|
||
);
|
||
}
|
||
#endif
|
||
tot_alloc_object_size += mstrsize(new_ob->name);
|
||
new_ob->load_name = ref_mstring(ob->load_name);
|
||
new_ob->flags |= O_CLONE | O_WILL_CLEAN_UP;
|
||
new_ob->prog = ob->prog;
|
||
reference_prog (ob->prog, "clone_object");
|
||
new_ob->ticks = new_ob->gigaticks = 0;
|
||
#ifdef DEBUG
|
||
if (!current_object)
|
||
fatal("clone_object() from no current_object !\n");
|
||
#endif
|
||
new_ob->next_all = obj_list;
|
||
new_ob->prev_all = NULL;
|
||
if (obj_list)
|
||
obj_list->prev_all = new_ob;
|
||
obj_list = new_ob;
|
||
if (!obj_list_end)
|
||
obj_list_end = new_ob;
|
||
num_listed_objs++;
|
||
enter_object_hash(new_ob); /* Add name to fast object lookup table */
|
||
push_give_uid_error_context(new_ob);
|
||
push_ref_object(inter_sp, ob, "clone_object");
|
||
push_ref_string(inter_sp, new_ob->name);
|
||
give_uid_to_object(new_ob, H_CLONE_UIDS, 2);
|
||
init_object_variables(new_ob, ob);
|
||
reset_object(new_ob, H_CREATE_CLONE);
|
||
command_giver = check_object(save_command_giver);
|
||
|
||
/* Never know what can happen ! :-( */
|
||
if (new_ob->flags & O_DESTRUCTED)
|
||
return NULL;
|
||
|
||
return new_ob;
|
||
} /* clone_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
object_t *
|
||
lookfor_object (string_t * str, Bool bLoad)
|
||
|
||
/* Look for a named object <str>, optionally loading it (<bLoad> is true).
|
||
* Return a pointer to the object structure, or NULL.
|
||
*
|
||
* If <bLoad> is true, the function tries to load the object if it is
|
||
* not already loaded.
|
||
* If <bLoad> is false, the function just checks if the object is loaded.
|
||
*
|
||
* The object is not swapped in.
|
||
*
|
||
* For easier usage, the macros find_object() and get_object() expand
|
||
* to the no-load- resp. load-call of this function.
|
||
*
|
||
* TODO: It would be nice if all loading uses of lookfor would go through
|
||
* TODO:: the efun load_object() or a driver hook so that the mudlib
|
||
* TODO:: has a chance to interfere with it. Dito for clone_object(), so
|
||
* TODO:: that the euid-check can be done there?
|
||
*/
|
||
{
|
||
object_t *ob;
|
||
const char * pName;
|
||
Bool isMasterObj = MY_FALSE;
|
||
|
||
if (mstreq(str, master_name_str))
|
||
isMasterObj = MY_TRUE;
|
||
|
||
/* TODO: It would be more useful to check all callers of lookfor()
|
||
* TODO:: and move the make_name_sane() into those where it can
|
||
* TODO:: be dirty.
|
||
*/
|
||
pName = make_name_sane(get_txt(str), MY_FALSE);
|
||
if (!pName)
|
||
pName = get_txt(str);
|
||
|
||
if (!isMasterObj && !strcmp(pName, get_txt(master_name_str)))
|
||
isMasterObj = MY_TRUE;
|
||
|
||
ob = lookup_object_hash_str(pName);
|
||
if (!bLoad)
|
||
return ob;
|
||
|
||
if (!ob)
|
||
{
|
||
ob = load_object(pName, 0, 0, isMasterObj, NULL);
|
||
}
|
||
if (!ob || ob->flags & O_DESTRUCTED)
|
||
return NULL;
|
||
return ob;
|
||
} /* lookfor_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
object_t *
|
||
find_object_str (const char * str)
|
||
|
||
/* Look for a named object <str>.
|
||
* Return a pointer to the object structure, or NULL.
|
||
*
|
||
* The object is not swapped in.
|
||
*/
|
||
{
|
||
const char * pName;
|
||
|
||
/* TODO: It would be more useful to check all callers of lookfor()
|
||
* TODO:: and move the make_name_sane() into those where it can
|
||
* TODO:: be dirty.
|
||
*/
|
||
pName = make_name_sane(str, MY_FALSE);
|
||
if (!pName)
|
||
pName = str;
|
||
|
||
return lookup_object_hash_str(pName);
|
||
} /* find_object_str() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
destruct_object (svalue_t *v)
|
||
|
||
/* Destruct the object named/passed in svalue <v>.
|
||
* This is the full program: the master:prepare_destruct() is called
|
||
* to clean the inventory of the object, and if it's an interactive,
|
||
* it is given the chance to save a pending editor buffer.
|
||
*
|
||
* The actual destruction work is then done in destruct().
|
||
*/
|
||
|
||
{
|
||
object_t *ob;
|
||
svalue_t *result;
|
||
|
||
/* Get the object to destruct */
|
||
if (v->type == T_OBJECT)
|
||
ob = v->u.ob;
|
||
else
|
||
{
|
||
ob = find_object(v->u.str);
|
||
if (ob == 0)
|
||
errorf("destruct_object: Could not find %s\n", get_txt(v->u.str));
|
||
}
|
||
|
||
if (ob->flags & O_DESTRUCTED)
|
||
return;
|
||
|
||
#ifdef USE_SWAP
|
||
if (ob->flags & O_SWAPPED)
|
||
if (load_ob_from_swap(ob) < 0)
|
||
errorf("Out of memory: unswap object '%s'\n", get_txt(ob->name));
|
||
#endif
|
||
|
||
if (d_flag)
|
||
{
|
||
debug_message("%s destruct_object: %s (ref %"PRIdPINT")\n"
|
||
, time_stamp(), get_txt(ob->name), ob->ref);
|
||
}
|
||
|
||
push_ref_object(inter_sp, ob, "destruct");
|
||
result = apply_master(STR_PREP_DEST, 1);
|
||
if (!result)
|
||
errorf("No prepare_destruct\n");
|
||
|
||
if (result->type == T_STRING)
|
||
errorf(get_txt(result->u.str));
|
||
|
||
if (result->type != T_NUMBER || result->u.number != 0)
|
||
return;
|
||
|
||
#ifdef USE_INVENTORIES
|
||
if (ob->contains)
|
||
{
|
||
errorf("Master failed to clean inventory in prepare_destruct\n");
|
||
}
|
||
#endif
|
||
|
||
if (ob->flags & O_SHADOW)
|
||
{
|
||
shadow_t *sh;
|
||
object_t *save = command_giver;
|
||
|
||
command_giver = ob;
|
||
sh = O_GET_SHADOW(ob);
|
||
if (sh->ip)
|
||
trace_level |= sh->ip->trace_level;
|
||
#ifdef USE_BUILTIN_EDITOR
|
||
if (sh->ed_buffer)
|
||
save_ed_buffer();
|
||
#endif
|
||
command_giver = save;
|
||
}
|
||
destruct(ob);
|
||
} /* destruct_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
deep_destruct (object_t *ob)
|
||
|
||
/* Destruct an object <ob> and the blueprint objects of all inherited
|
||
* programs. The actual destruction work is done by destruct().
|
||
*
|
||
* The objects are still kept around until the end of the execution because
|
||
* it might still hold a running program. The destruction will be completed
|
||
* from the backend by a call to handle_newly_destructed_objects().
|
||
*/
|
||
|
||
{
|
||
program_t *prog;
|
||
|
||
/* Destruct the object itself */
|
||
destruct(ob);
|
||
|
||
/* Loop through all the inherits and destruct the blueprints
|
||
* of the inherited programs.
|
||
*/
|
||
prog = ob->prog;
|
||
if (prog != NULL)
|
||
{
|
||
int i;
|
||
|
||
for (i = 0; i < prog->num_inherited; ++i)
|
||
{
|
||
program_t *iprog = prog->inherit[i].prog;
|
||
|
||
if (iprog != NULL && iprog->blueprint != NULL)
|
||
{
|
||
destruct(iprog->blueprint);
|
||
}
|
||
}
|
||
}
|
||
} /* deep_destruct() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
destruct (object_t *ob)
|
||
|
||
/* Really destruct an object <ob>. This function is called from
|
||
* destruct_object() to do the actual work, and also directly in situations
|
||
* where the master is out of order or the object not fully initialized.
|
||
*
|
||
* The function:
|
||
* - marks the object as destructed
|
||
* - moves it out of the global object list and the object able, into
|
||
* the list of destructed objects
|
||
* - changes all references on the interpreter stack to svalue-0
|
||
* - moves it out of its environment
|
||
* - removes all shadows.
|
||
*
|
||
* The object is still kept around until the end of the execution because
|
||
* it might still hold a running program. The destruction will be completed
|
||
* from the backend by a call to handle_newly_destructed_objects().
|
||
*/
|
||
|
||
{
|
||
#ifdef USE_INVENTORIES
|
||
# ifdef USE_SHADOWING
|
||
object_t **pp;
|
||
# endif
|
||
object_t *item, *next;
|
||
#endif
|
||
#ifdef CHECK_OBJECT_REF
|
||
object_shadow_t *shadow;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
|
||
if (ob->flags & O_DESTRUCTED)
|
||
return;
|
||
|
||
#ifdef CHECK_OBJECT_REF
|
||
xallocate(shadow, sizeof(*shadow), "destructed object shadow");
|
||
#endif /* CHECK_OBJECT_REF */
|
||
#ifdef USE_SQLITE
|
||
if (ob->open_sqlite_db)
|
||
sl_close(ob);
|
||
#endif
|
||
ob->time_reset = 0;
|
||
|
||
#ifdef USE_SWAP
|
||
/* We need the object in memory */
|
||
if (ob->flags & O_SWAPPED)
|
||
{
|
||
int save_privilege;
|
||
|
||
save_privilege = malloc_privilege;
|
||
malloc_privilege = MALLOC_SYSTEM;
|
||
load_ob_from_swap(ob);
|
||
malloc_privilege = save_privilege;
|
||
}
|
||
#endif
|
||
|
||
/* If there are shadows, remove them */
|
||
if (ob->flags & O_SHADOW)
|
||
{
|
||
shadow_t *shadow_sent;
|
||
#ifdef USE_SHADOWING
|
||
object_t *shadowing, *shadowed_by;
|
||
#endif
|
||
|
||
shadow_sent = O_GET_SHADOW(ob);
|
||
|
||
#ifdef USE_BUILTIN_EDITOR
|
||
if (shadow_sent->ed_buffer)
|
||
{
|
||
object_t *save = command_giver;
|
||
|
||
command_giver = ob;
|
||
free_ed_buffer();
|
||
command_giver = save;
|
||
}
|
||
#endif
|
||
|
||
#ifdef USE_SHADOWING
|
||
/* The chain of shadows is a double linked list. Take care to update
|
||
* it correctly.
|
||
*/
|
||
if ( NULL != (shadowing = shadow_sent->shadowing) )
|
||
{
|
||
shadow_t *shadowing_sent;
|
||
|
||
/* Remove the shadow sent from the chain */
|
||
shadowing_sent = O_GET_SHADOW(shadowing);
|
||
shadow_sent->shadowing = NULL;
|
||
shadowing_sent->shadowed_by = shadow_sent->shadowed_by;
|
||
check_shadow_sent(shadowing);
|
||
|
||
#ifdef USE_ACTIONS
|
||
/* This object, the shadow, may have added actions to
|
||
* the shadowee, or it's vicinity. Take care to remove
|
||
* them all.
|
||
*/
|
||
remove_shadow_actions(ob, shadowing);
|
||
#endif
|
||
}
|
||
|
||
if ( NULL != (shadowed_by = shadow_sent->shadowed_by) )
|
||
{
|
||
shadow_t *shadowed_by_sent;
|
||
|
||
/* Remove the shadow sent from the chain */
|
||
shadowed_by_sent = O_GET_SHADOW(shadowed_by);
|
||
shadow_sent->shadowed_by = NULL;
|
||
shadowed_by_sent->shadowing = shadowing;
|
||
check_shadow_sent(shadowed_by);
|
||
|
||
/* Our shadows may have added actions to us or to our
|
||
* environment. Take care to remove them all.
|
||
*/
|
||
do {
|
||
#ifdef USE_ACTIONS
|
||
remove_shadow_actions(shadowed_by, ob);
|
||
#endif
|
||
if (O_GET_SHADOW(shadowed_by) != NULL)
|
||
shadowed_by = O_GET_SHADOW(shadowed_by)->shadowed_by;
|
||
else
|
||
shadowed_by = NULL;
|
||
} while (shadowed_by != NULL);
|
||
}
|
||
#endif
|
||
|
||
check_shadow_sent(ob);
|
||
}
|
||
|
||
#ifdef USE_INVENTORIES
|
||
/* Move all objects in the inventory into the "void" */
|
||
for (item = ob->contains; item; item = next)
|
||
{
|
||
#ifdef USE_SHADOWING
|
||
remove_action_sent(ob, item);
|
||
#endif
|
||
item->super = NULL;
|
||
next = item->next_inv;
|
||
item->next_inv = NULL;
|
||
}
|
||
#endif
|
||
|
||
remove_object_from_stack(ob);
|
||
|
||
if (ob == simul_efun_object)
|
||
{
|
||
simul_efun_object = NULL;
|
||
invalidate_simul_efuns();
|
||
}
|
||
|
||
set_heart_beat(ob, MY_FALSE);
|
||
|
||
#ifdef USE_INVENTORIES
|
||
/* Remove us out of this current room (if any).
|
||
* Remove all sentences defined by this object from all objects here.
|
||
*/
|
||
if (ob->super)
|
||
{
|
||
#ifdef USE_SHADOWING
|
||
if (ob->super->sent)
|
||
remove_action_sent(ob, ob->super);
|
||
#endif
|
||
|
||
# ifdef USE_SET_LIGHT
|
||
add_light(ob->super, - ob->total_light);
|
||
# endif
|
||
|
||
#ifdef USE_SHADOWING
|
||
for (pp = &ob->super->contains; *pp;)
|
||
{
|
||
if ((*pp)->sent)
|
||
remove_action_sent(ob, *pp);
|
||
if (*pp != ob)
|
||
pp = &(*pp)->next_inv;
|
||
else
|
||
*pp = (*pp)->next_inv;
|
||
}
|
||
#endif
|
||
}
|
||
#endif
|
||
|
||
/* Now remove us out of the list of all objects.
|
||
* This must be done last, because an error in the above code would
|
||
* halt execution.
|
||
*/
|
||
remove_object_hash(ob);
|
||
if (ob->prev_all)
|
||
ob->prev_all->next_all = ob->next_all;
|
||
if (ob->next_all)
|
||
ob->next_all->prev_all = ob->prev_all;
|
||
if (ob == obj_list)
|
||
obj_list = ob->next_all;
|
||
if (ob == obj_list_end)
|
||
obj_list_end = ob->prev_all;
|
||
|
||
num_listed_objs--;
|
||
|
||
#ifdef USE_INVENTORIES
|
||
ob->super = NULL;
|
||
ob->next_inv = NULL;
|
||
ob->contains = NULL;
|
||
#endif
|
||
ob->flags &= ~O_ENABLE_COMMANDS;
|
||
ob->flags |= O_DESTRUCTED; /* must come last! */
|
||
if (command_giver == ob)
|
||
command_giver = NULL;
|
||
|
||
#ifdef USE_EXPAT
|
||
if (ob->xml_parser != NULL) { /* free parser */
|
||
XML_ParserFree(ob->xml_parser);
|
||
ob->xml_parser = NULL;
|
||
}
|
||
#endif
|
||
|
||
/* Put the object into the list of newly destructed objects */
|
||
ob->prev_all = NULL;
|
||
ob->next_all = newly_destructed_objs;
|
||
newly_destructed_objs = ob;
|
||
num_newly_destructed++;
|
||
#ifdef CHECK_OBJECT_REF
|
||
shadow->obj = ob;
|
||
shadow->ref = ob->ref;
|
||
shadow->flags = ob->flags;
|
||
shadow->sent = ob->sent;
|
||
shadow->next = newly_destructed_obj_shadows;
|
||
newly_destructed_obj_shadows = shadow;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
} /* destruct() */
|
||
|
||
#ifdef CHECK_OBJECT_REF
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
check_object_shadow (object_t *ob, object_shadow_t *sh)
|
||
{
|
||
if (sh->obj != ob)
|
||
fatal("DEBUG: Obj %p '%s', shadow %p -> obj %p '%s'\n"
|
||
, ob, get_txt(ob->name), sh, sh->obj, get_txt(sh->obj->name));
|
||
if ((sh->flags & O_DESTRUCTED) != (ob->flags & O_DESTRUCTED)
|
||
|| sh->sent != ob->sent
|
||
)
|
||
fatal("DEBUG: Obj %p '%s': ref %"PRIdPINT", flags %x, sent %p;"
|
||
"shadow ref %"PRIdPINT", flags %x, sent %p\n"
|
||
, ob, get_txt(ob->name), ob->ref, ob->flags, ob->sent
|
||
, sh->ref, sh->flags, sh->sent
|
||
);
|
||
} /* check_object_shadow() */
|
||
|
||
void
|
||
check_all_object_shadows (void)
|
||
{
|
||
object_shadow_t *sh;
|
||
object_t * ob;
|
||
|
||
for (ob = newly_destructed_objs, sh = newly_destructed_obj_shadows
|
||
; ob != NULL
|
||
; ob = ob->next_all, sh = sh->next
|
||
)
|
||
check_object_shadow(ob, sh);
|
||
|
||
for (ob = destructed_objs, sh = destructed_obj_shadows
|
||
; ob != NULL
|
||
; ob = ob->next_all, sh = sh->next
|
||
)
|
||
check_object_shadow(ob, sh);
|
||
} /* check_object_shadows() */
|
||
|
||
void
|
||
update_object_sent(object_t *obj, sentence_t *new_sent)
|
||
{
|
||
object_shadow_t *sh;
|
||
if (!(obj->flags & O_DESTRUCTED))
|
||
{
|
||
obj->sent = new_sent;
|
||
return;
|
||
}
|
||
for (sh = newly_destructed_obj_shadows; sh != NULL; sh = sh->next)
|
||
if (sh->obj == obj)
|
||
break;
|
||
if (sh == NULL)
|
||
for (sh = newly_destructed_obj_shadows; sh != NULL; sh = sh->next)
|
||
if (sh->obj == obj)
|
||
break;
|
||
if (sh == NULL)
|
||
{
|
||
fatal("DEBUG: Obj %p '%s': ref %"PRIdPINT", flags %x, sent %p; no shadow found\n"
|
||
, obj, get_txt(obj->name), obj->ref, obj->flags, obj->sent
|
||
);
|
||
}
|
||
check_object_shadow(obj, sh);
|
||
obj->sent = new_sent;
|
||
sh->sent = new_sent;
|
||
}
|
||
|
||
#endif /* CHECK_OBJECT_REF */
|
||
/*-------------------------------------------------------------------------*/
|
||
static void
|
||
remove_object (object_t *ob
|
||
#ifdef CHECK_OBJECT_REF
|
||
, object_shadow_t *sh
|
||
#endif /* CHECK_OBJECT_REF */
|
||
)
|
||
|
||
/* This function is called from outside any execution thread to finally
|
||
* remove object <ob>. <ob> must have been unlinked from all object lists
|
||
* already (but the associated reference count must still exist).
|
||
*
|
||
* The function frees all variables and remaining sentences in the object.
|
||
* If then only one reference (from the original object list) remains, the
|
||
* object is freed immediately with a call to free_object(). If more
|
||
* references exist, the object is linked into the destructed_objs list
|
||
* for freeing at a future date.
|
||
*
|
||
* The object structure and the program will be freed as soon as there
|
||
* are no further references to the object (the program will remain behind
|
||
* in case it was inherited).
|
||
* TODO: Distinguish data- and inheritance references?
|
||
*/
|
||
|
||
{
|
||
sentence_t *sent;
|
||
|
||
#ifdef CHECK_OBJECT_REF
|
||
check_object_shadow(ob, sh);
|
||
#endif
|
||
if (d_flag > 1)
|
||
{
|
||
debug_message("%s remove_object: object %s (ref %"PRIdPINT")\n"
|
||
, time_stamp(), get_txt(ob->name), ob->ref);
|
||
}
|
||
|
||
if (O_IS_INTERACTIVE(ob))
|
||
remove_interactive(ob, MY_FALSE);
|
||
|
||
/* If this is a blueprint object, NULL out the pointer in the program
|
||
* to remove the extraneous reference.
|
||
*/
|
||
if (ob->prog->blueprint == ob)
|
||
{
|
||
ob->prog->blueprint = NULL;
|
||
#ifdef USE_SWAP
|
||
remove_prog_swap(ob->prog, MY_TRUE);
|
||
#endif
|
||
free_object(ob, "remove_object: blueprint reference");
|
||
}
|
||
|
||
/* We must deallocate variables here, not in 'free_object()'.
|
||
* That is because one of the local variables may point to this object,
|
||
* and deallocation of this pointer will also decrease the reference
|
||
* count of this object. Otherwise, an object with a variable pointing
|
||
* to itself would never be freed.
|
||
* Just in case the program in this object would continue to
|
||
* execute, change string and object variables into the number 0.
|
||
*/
|
||
if (ob->prog->num_variables > 0)
|
||
{
|
||
/* Deallocate variables in this object.
|
||
*/
|
||
int i;
|
||
for (i = 0; i < ob->prog->num_variables; i++)
|
||
{
|
||
free_svalue(&ob->variables[i]);
|
||
put_number(ob->variables+i, 0);
|
||
}
|
||
xfree(ob->variables);
|
||
}
|
||
#ifdef DEBUG
|
||
else if (ob->variables != NULL)
|
||
{
|
||
debug_message("%s Warning: Object w/o variables, but variable block "
|
||
"at %p\n", time_stamp(), ob->variables);
|
||
}
|
||
#endif
|
||
|
||
/* This should be here to avoid using up memory as long as the object
|
||
* isn't released. It must be here because gcollect doesn't expect
|
||
* sentences in destructed objects.
|
||
*/
|
||
if ( NULL != (sent = ob->sent) )
|
||
{
|
||
sentence_t *next;
|
||
do {
|
||
|
||
next = sent->next;
|
||
if (sent->type == SENT_SHADOW)
|
||
free_shadow_sent((shadow_t *)sent);
|
||
#ifdef USE_ACTIONS
|
||
else
|
||
free_action_sent((action_t *)sent);
|
||
#endif
|
||
} while ( NULL != (sent = next) );
|
||
ob->sent = NULL;
|
||
#ifdef CHECK_OBJECT_REF
|
||
sh->sent = NULL;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
}
|
||
|
||
/* Either free the object, or link it up for future freeing. */
|
||
if (ob->ref <= 1)
|
||
{
|
||
free_object(ob, "destruct_object");
|
||
#ifdef CHECK_OBJECT_REF
|
||
xfree(sh);
|
||
#endif /* CHECK_OBJECT_REF */
|
||
}
|
||
else
|
||
{
|
||
if (destructed_objs != NULL)
|
||
destructed_objs->prev_all = ob;
|
||
ob->next_all = destructed_objs;
|
||
destructed_objs = ob;
|
||
ob->prev_all = NULL;
|
||
num_destructed++;
|
||
#ifdef CHECK_OBJECT_REF
|
||
sh->next = destructed_obj_shadows;
|
||
destructed_obj_shadows = sh;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
}
|
||
} /* remove_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
handle_newly_destructed_objects (void)
|
||
|
||
/* Finish up all newly destructed objects kept in the newly_destructed_objs
|
||
* list: deallocate as many associated resources and, if there are
|
||
* more than one references to the object, put it into the destructed_objs list.
|
||
*/
|
||
|
||
{
|
||
while (newly_destructed_objs)
|
||
{
|
||
object_t *ob = newly_destructed_objs;
|
||
|
||
#ifdef CHECK_OBJECT_REF
|
||
object_t *next_ob = ob->next_all;
|
||
object_shadow_t *sh = newly_destructed_obj_shadows;
|
||
object_shadow_t *next_sh = sh->next;
|
||
#else
|
||
newly_destructed_objs = ob->next_all;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
|
||
#ifdef DEBUG
|
||
if (!(ob->flags & O_DESTRUCTED))
|
||
fatal("Non-destructed object %p '%s' in list of destructed objects.\n"
|
||
, ob, ob->name ? get_txt(ob->name) : "<null>"
|
||
);
|
||
#endif
|
||
#ifdef CHECK_OBJECT_REF
|
||
remove_object(ob, sh);
|
||
newly_destructed_objs = next_ob;
|
||
newly_destructed_obj_shadows = next_sh;
|
||
#else
|
||
remove_object(ob);
|
||
#endif /* CHECK_OBJECT_REF */
|
||
num_newly_destructed--;
|
||
}
|
||
} /* handle_newly_destructed_objects() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
remove_destructed_objects (Bool force)
|
||
|
||
/* Scan the list of destructed objects and free those with no references
|
||
* remaining.
|
||
* If <force> is FALSE, the call immediately returns if the flag
|
||
* <dest_last_ref_gone> (in object.c) is FALSE - this flag is set by
|
||
* free_object() if all but one reference to a destructed object is gone.
|
||
* If <force> is TRUE, the scan takes place unconditionally (this is used by
|
||
* the GC).
|
||
*/
|
||
|
||
{
|
||
object_t *ob;
|
||
#ifdef CHECK_OBJECT_REF
|
||
object_shadow_t *sh = destructed_obj_shadows;
|
||
object_shadow_t *prev = NULL;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
|
||
if (!force && !dest_last_ref_gone)
|
||
return;
|
||
|
||
dest_last_ref_gone = MY_FALSE;
|
||
|
||
for (ob = destructed_objs; ob != NULL; )
|
||
{
|
||
object_t *victim;
|
||
|
||
#ifdef CHECK_OBJECT_REF
|
||
check_object_shadow(ob, sh);
|
||
#endif /* CHECK_OBJECT_REF */
|
||
/* Check if only the list reference remains.
|
||
* If not, go to the next object.
|
||
*/
|
||
if (ob->ref > 1)
|
||
{
|
||
ob = ob->next_all;
|
||
#ifdef CHECK_OBJECT_REF
|
||
prev = sh;
|
||
sh = sh->next;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
continue;
|
||
}
|
||
|
||
/* This object can be freed - remove it from the list */
|
||
victim = ob;
|
||
if (ob->prev_all != NULL)
|
||
ob->prev_all->next_all = ob->next_all;
|
||
if (ob->next_all != NULL)
|
||
ob->next_all->prev_all = ob->prev_all;
|
||
if (destructed_objs == ob)
|
||
destructed_objs = ob->next_all;
|
||
ob = ob->next_all;
|
||
|
||
free_object(victim, "remove_destructed_objects");
|
||
num_destructed--;
|
||
#ifdef CHECK_OBJECT_REF
|
||
{
|
||
object_shadow_t * next = sh->next;
|
||
if (prev == NULL)
|
||
{
|
||
destructed_obj_shadows = next;
|
||
}
|
||
else
|
||
{
|
||
prev->next = next;
|
||
}
|
||
xfree(sh);
|
||
sh = next;
|
||
}
|
||
#endif /* CHECK_OBJECT_REF */
|
||
}
|
||
} /* remove_destructed_objects() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static INLINE shadow_t *
|
||
new_shadow_sent(void)
|
||
|
||
/* Allocate a new empty shadow sentence and return it.
|
||
*/
|
||
|
||
{
|
||
shadow_t *p;
|
||
|
||
xallocate(p, sizeof *p, "new shadow sentence");
|
||
alloc_shadow_sent++;
|
||
|
||
p->sent.type = SENT_SHADOW;
|
||
#ifdef USE_SHADOWING
|
||
p->shadowing = NULL;
|
||
p->shadowed_by = NULL;
|
||
#endif
|
||
#ifdef USE_BUILTIN_EDITOR
|
||
p->ed_buffer = NULL;
|
||
#endif
|
||
p->ip = NULL;
|
||
return p;
|
||
} /* new_shadow_sent() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static void
|
||
free_shadow_sent (shadow_t *p)
|
||
|
||
/* Free the shadow sentence <p>.
|
||
*/
|
||
|
||
{
|
||
#ifdef DEBUG
|
||
if (SENT_SHADOW != p->sent.type)
|
||
fatal("free_shadow_sent() received non-shadow sent type %d\n"
|
||
, p->sent.type);
|
||
#endif
|
||
|
||
xfree(p);
|
||
alloc_shadow_sent--;
|
||
} /* free_shadow_sent() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
check_shadow_sent (object_t *ob)
|
||
|
||
/* Check if object <ob> has a shadow sentence and really needs it.
|
||
* If yes and no, the sentence is removed.
|
||
*/
|
||
|
||
{
|
||
if (ob->flags & O_SHADOW)
|
||
{
|
||
shadow_t *sh;
|
||
|
||
sh = O_GET_SHADOW(ob);
|
||
|
||
if (!sh->ip
|
||
#ifdef USE_BUILTIN_EDITOR
|
||
&& !sh->ed_buffer
|
||
#endif
|
||
#ifdef USE_SHADOWING
|
||
&& !sh->shadowing
|
||
&& !sh->shadowed_by
|
||
#endif
|
||
)
|
||
{
|
||
#ifdef CHECK_OBJECT_REF
|
||
update_object_sent(ob, sh->sent.next);
|
||
#else
|
||
ob->sent = sh->sent.next;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
free_shadow_sent(sh);
|
||
ob->flags &= ~O_SHADOW;
|
||
}
|
||
}
|
||
} /* check_shadow_sent() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
assert_shadow_sent (object_t *ob)
|
||
|
||
/* Make sure that object <ob> has a shadow sentence.
|
||
*/
|
||
|
||
{
|
||
if (!(ob->flags & O_SHADOW))
|
||
{
|
||
shadow_t *sh;
|
||
|
||
sh = new_shadow_sent();
|
||
sh->sent.next = ob->sent;
|
||
#ifdef CHECK_OBJECT_REF
|
||
update_object_sent(ob, (sentence_t *)sh);
|
||
#else
|
||
ob->sent = (sentence_t *)sh;
|
||
#endif /* CHECK_OBJECT_REF */
|
||
ob->flags |= O_SHADOW;
|
||
}
|
||
} /* assert_shadow_sent() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
Bool
|
||
status_parse (strbuf_t * sbuf, char * buff)
|
||
|
||
/* Parse the status request in <buff> and if recognized, dump the
|
||
* data into the stringbuffer <sbuf>.
|
||
*
|
||
* Return TRUE if the request was recognised, and FALSE otherwise.
|
||
*
|
||
* The function is called from actions:special_parse() to implement
|
||
* the hardcoded commands, and from the efun debug_info().
|
||
*/
|
||
|
||
{
|
||
if (sbuf)
|
||
strbuf_zero(sbuf);
|
||
|
||
if (!buff || *buff == 0 || strcmp(buff, "tables") == 0)
|
||
{
|
||
size_t tot, res;
|
||
Bool verbose = MY_FALSE;
|
||
|
||
if (strcmp(buff, "tables") == 0)
|
||
verbose = MY_TRUE;
|
||
|
||
res = 0;
|
||
if (reserved_user_area)
|
||
res = reserved_user_size;
|
||
if (reserved_master_area)
|
||
res += reserved_master_size;
|
||
if (reserved_system_area)
|
||
res += reserved_system_size;
|
||
if (!verbose)
|
||
{
|
||
#ifdef USE_ACTIONS
|
||
strbuf_addf(sbuf, "Actions:\t\t\t%8"PRIdPINT" %9"PRIdPINT"\n"
|
||
, alloc_action_sent
|
||
, alloc_action_sent * sizeof (action_t));
|
||
#endif
|
||
#ifdef USE_SHADOWS
|
||
strbuf_addf(sbuf, "Shadows:\t\t\t%8"PRIdPINT" %9"PRIdPINT"\n"
|
||
, alloc_shadow_sent
|
||
, alloc_shadow_sent * sizeof (shadow_t));
|
||
#endif
|
||
strbuf_addf(sbuf, "Objects:\t\t\t%8ld %9ld (%ld destructed;"
|
||
" %"PRIdMPINT" swapped: %"PRIdMPINT" Kbytes)\n"
|
||
, tot_alloc_object, tot_alloc_object_size
|
||
, num_destructed
|
||
, num_vb_swapped, total_vb_bytes_swapped / 1024);
|
||
strbuf_addf(sbuf, "Prog blocks:\t\t\t%8"PRIdMPINT" %9"PRIdMPINT
|
||
" (%"PRIdMPINT" swapped: %"PRIdMPINT" Kbytes)\n"
|
||
, total_num_prog_blocks + num_swapped - num_unswapped
|
||
, total_prog_block_size + total_bytes_swapped
|
||
- total_bytes_unswapped
|
||
, num_swapped - num_unswapped
|
||
, (total_bytes_swapped - total_bytes_unswapped) / 1024);
|
||
strbuf_addf(sbuf, "Arrays:\t\t\t\t%8ld %9ld\n"
|
||
, (long)num_arrays, total_array_size() );
|
||
strbuf_addf(sbuf, "Mappings:\t\t\t%8"PRIdMPINT" %9"PRIdMPINT
|
||
" (%"PRIdMPINT" hybrid, %"PRIdMPINT" hash)\n"
|
||
, num_mappings, total_mapping_size()
|
||
, num_dirty_mappings, num_hash_mappings
|
||
);
|
||
strbuf_addf(sbuf, "Memory reserved:\t\t\t %9zu\n", res);
|
||
}
|
||
if (verbose) {
|
||
/* TODO: Add these numbers to the debug_info statistics. */
|
||
strbuf_add(sbuf, "\nVM Execution:\n");
|
||
strbuf_add(sbuf, "-------------\n");
|
||
strbuf_addf(sbuf
|
||
, "Last: %10lu ticks, %3ld.%06ld s\n"
|
||
"Average: %10.0lf ticks, %10.6lf s\n"
|
||
, last_total_evalcost
|
||
, last_eval_duration.tv_sec, (long)last_eval_duration.tv_usec
|
||
, stat_total_evalcost.weighted_avg
|
||
, stat_eval_duration.weighted_avg / 1000000.0
|
||
);
|
||
strbuf_addf(sbuf
|
||
, "Load: %.2lf cmds/s, %.2lf comp lines/s\n"
|
||
, stat_load.weighted_avg
|
||
, stat_compile.weighted_avg
|
||
);
|
||
|
||
#ifdef COMM_STAT
|
||
strbuf_add(sbuf, "\nNetwork IO:\n");
|
||
strbuf_add(sbuf, "-----------\n");
|
||
strbuf_addf(sbuf
|
||
, "In: Packets: %10lu - Sum: %10lu - "
|
||
"Average packet size: %7.2f\n"
|
||
, inet_packets_in
|
||
, inet_volume_in
|
||
, inet_packets_in ? (float)inet_volume_in/(float)inet_packets_in : 0.0
|
||
);
|
||
strbuf_addf(sbuf
|
||
, "Out: Packets: %10lu - Sum: %10lu - "
|
||
"Average packet size: %7.2f\n"
|
||
" Calls to add_message: %lu\n"
|
||
, inet_packets
|
||
, inet_volume
|
||
, inet_packets ? (float)inet_volume/(float)inet_packets : 0.0
|
||
, add_message_calls
|
||
);
|
||
#endif
|
||
#ifdef APPLY_CACHE_STAT
|
||
strbuf_add(sbuf, "\nApply Cache:\n");
|
||
strbuf_add(sbuf, "------------\n");
|
||
strbuf_addf(sbuf
|
||
, "Calls to apply_low: %10"PRIuPINT"\n"
|
||
"Cache hits: %10"PRIuPINT" (%.2f%%)\n"
|
||
, (apply_cache_hit+apply_cache_miss)
|
||
, apply_cache_hit
|
||
, 100.*(float)apply_cache_hit/
|
||
(float)(apply_cache_hit+apply_cache_miss) );
|
||
#endif
|
||
}
|
||
tot = total_prog_block_size;
|
||
tot += total_array_size();
|
||
tot += tot_alloc_object_size;
|
||
#ifdef USE_ACTIONS
|
||
tot += alloc_action_sent * sizeof(action_t);
|
||
#endif
|
||
#ifdef USE_SHADOWS
|
||
tot += alloc_shadow_sent * sizeof(shadow_t);
|
||
#endif
|
||
if (verbose)
|
||
{
|
||
#ifdef DEBUG
|
||
unsigned long count;
|
||
object_t *ob;
|
||
#endif
|
||
|
||
strbuf_add(sbuf, "\nObject status:\n");
|
||
strbuf_add(sbuf, "--------------\n");
|
||
strbuf_addf(sbuf, "Objects total:\t\t\t %8ld\n"
|
||
, tot_alloc_object);
|
||
#ifndef DEBUG
|
||
strbuf_addf(sbuf, "Objects in list:\t\t %8lu\n"
|
||
, (unsigned long)num_listed_objs);
|
||
strbuf_addf(sbuf, "Objects newly destructed:\t\t %8ld\n"
|
||
, num_newly_destructed);
|
||
strbuf_addf(sbuf, "Objects destructed:\t\t %8ld\n"
|
||
, num_destructed);
|
||
#else
|
||
for (count = 0, ob = obj_list; ob != NULL; ob = ob->next_all)
|
||
count++;
|
||
if (count != (long)num_listed_objs)
|
||
{
|
||
debug_message("DEBUG: num_listed_objs mismatch: listed %lu, counted %lu\n"
|
||
, (unsigned long)num_listed_objs, count);
|
||
strbuf_addf(sbuf, "Objects in list:\t\t %8lu (counted %lu)\n"
|
||
, (unsigned long)num_listed_objs, count);
|
||
}
|
||
else
|
||
strbuf_addf(sbuf, "Objects in list:\t\t %8lu\n"
|
||
, (unsigned long)num_listed_objs);
|
||
for (count = 0, ob = newly_destructed_objs; ob != NULL; ob = ob->next_all)
|
||
count++;
|
||
if (count != num_newly_destructed)
|
||
{
|
||
debug_message("DEBUG: num_newly_destructed mismatch: listed %ld, counted %lu\n"
|
||
, num_newly_destructed, count);
|
||
strbuf_addf(sbuf, "Objects newly destructed:\t\t %8ld (counted %lu)\n"
|
||
, num_newly_destructed, count);
|
||
}
|
||
else
|
||
strbuf_addf(sbuf, "Objects newly destructed:\t %8ld\n"
|
||
, num_newly_destructed);
|
||
for (count = 0, ob = destructed_objs; ob != NULL; ob = ob->next_all)
|
||
count++;
|
||
if (count != num_destructed)
|
||
{
|
||
debug_message("DEBUG: num_destructed mismatch: listed %ld, counted %lu\n"
|
||
, num_destructed, count);
|
||
strbuf_addf(sbuf, "Objects destructed:\t\t %8ld (counted %lu)\n"
|
||
, num_destructed, count);
|
||
}
|
||
else
|
||
strbuf_addf(sbuf, "Objects destructed:\t\t %8ld\n"
|
||
, num_destructed);
|
||
#endif
|
||
|
||
strbuf_addf(sbuf, "Objects processed in last cycle: "
|
||
"%8lu (%5.1lf%% - avg. %5.1lf%%)\n"
|
||
, (unsigned long)num_last_processed
|
||
, (float)num_last_processed / (float)num_listed_objs * 100.0
|
||
, 100.0 * relate_statistics(stat_last_processed, stat_in_list)
|
||
);
|
||
#ifdef NEW_CLEANUP
|
||
strbuf_addf(sbuf, "Objects data-cleaned in last cycle: "
|
||
"%5lu (%5.1lf%% - avg. %5.1lf : %5.1lf%%)\n"
|
||
, (unsigned long)num_last_data_cleaned
|
||
, (double)num_last_data_cleaned / (double)num_listed_objs * 100.0
|
||
, stat_last_data_cleaned.weighted_avg
|
||
, 100.0 * relate_statistics(stat_last_data_cleaned, stat_in_list)
|
||
);
|
||
#endif
|
||
}
|
||
tot += show_otable_status(sbuf, verbose);
|
||
tot += heart_beat_status(sbuf, verbose);
|
||
tot += add_string_status(sbuf, verbose);
|
||
tot += call_out_status(sbuf, verbose);
|
||
tot += total_mapping_size();
|
||
#ifdef USE_STRUCTS
|
||
tot += total_struct_size(sbuf, verbose);
|
||
#endif
|
||
tot += rxcache_status(sbuf, verbose);
|
||
if (verbose)
|
||
{
|
||
strbuf_add(sbuf, "\nOther:\n");
|
||
strbuf_add(sbuf, "------\n");
|
||
}
|
||
tot += show_lexer_status(sbuf, verbose);
|
||
tot += show_comm_status(sbuf, verbose);
|
||
if (!verbose)
|
||
{
|
||
size_t other;
|
||
|
||
other = wiz_list_size();
|
||
#ifdef USE_SWAP
|
||
other += swap_overhead();
|
||
#endif
|
||
other += num_simul_efun * sizeof(function_t);
|
||
other += interpreter_overhead();
|
||
strbuf_addf(sbuf, "Other structures\t\t\t %9zu\n", other);
|
||
tot += other;
|
||
}
|
||
tot += mb_status(sbuf, verbose);
|
||
tot += res;
|
||
|
||
if (!verbose) {
|
||
strbuf_add(sbuf, "\t\t\t\t\t ---------\n");
|
||
strbuf_add(sbuf, "Total:\t\t\t\t\t ");
|
||
strbuf_addf(sbuf, "%9zu\n", tot);
|
||
}
|
||
return MY_TRUE;
|
||
}
|
||
|
||
#ifdef USE_SWAP
|
||
if (strcmp(buff, "swap") == 0)
|
||
{
|
||
swap_status(sbuf);
|
||
return MY_TRUE;
|
||
}
|
||
#endif
|
||
|
||
if (strcmp(buff, "malloc") == 0) {
|
||
mem_dump_data(sbuf);
|
||
return MY_TRUE;
|
||
}
|
||
|
||
if (strcmp(buff, "malloc extstats") == 0) {
|
||
mem_dump_extdata(sbuf);
|
||
return MY_TRUE;
|
||
}
|
||
|
||
return MY_FALSE;
|
||
} /* status_parse() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
dinfo_data_status (svalue_t *svp, int value)
|
||
|
||
/* Fill in the "status" data for debug_info(DINFO_DATA, DID_STATUS)
|
||
* into the svalue-block <svp>.
|
||
* If <value> is -1, <svp> points indeed to a value block; other it is
|
||
* the index of the desired value and <svp> points to a single svalue.
|
||
*/
|
||
|
||
{
|
||
STORE_DOUBLE_USED;
|
||
|
||
#define ST_NUMBER(which,code) \
|
||
if (value == -1) svp[which].u.number = code; \
|
||
else if (value == which) svp->u.number = code
|
||
|
||
#define ST_DOUBLE(which,code) \
|
||
if (value == -1) { \
|
||
svp[which].type = T_FLOAT; \
|
||
STORE_DOUBLE(svp+which, code); \
|
||
} else if (value == which) { \
|
||
svp->type = T_FLOAT; \
|
||
STORE_DOUBLE(svp, code); \
|
||
}
|
||
|
||
#ifdef USE_ACTIONS
|
||
ST_NUMBER(DID_ST_ACTIONS, alloc_action_sent);
|
||
ST_NUMBER(DID_ST_ACTIONS_SIZE, alloc_action_sent * sizeof (action_t));
|
||
#endif
|
||
#ifdef USE_SHADOWS
|
||
ST_NUMBER(DID_ST_SHADOWS, alloc_shadow_sent);
|
||
ST_NUMBER(DID_ST_SHADOWS_SIZE, alloc_shadow_sent * sizeof (shadow_t));
|
||
#endif
|
||
|
||
ST_NUMBER(DID_ST_OBJECTS, tot_alloc_object);
|
||
ST_NUMBER(DID_ST_OBJECTS_SIZE, tot_alloc_object_size);
|
||
ST_NUMBER(DID_ST_OBJECTS_SWAPPED, num_vb_swapped);
|
||
ST_NUMBER(DID_ST_OBJECTS_SWAP_SIZE, total_vb_bytes_swapped);
|
||
ST_NUMBER(DID_ST_OBJECTS_LIST, num_listed_objs);
|
||
ST_NUMBER(DID_ST_OBJECTS_NEWLY_DEST, num_newly_destructed);
|
||
ST_NUMBER(DID_ST_OBJECTS_DESTRUCTED, num_destructed);
|
||
ST_NUMBER(DID_ST_OBJECTS_PROCESSED, num_last_processed);
|
||
ST_DOUBLE(DID_ST_OBJECTS_AVG_PROC, relate_statistics(stat_last_processed, stat_in_list));
|
||
/* TODO: Maybe add number of objects data cleaned here as well. */
|
||
|
||
ST_NUMBER(DID_ST_ARRAYS, num_arrays);
|
||
ST_NUMBER(DID_ST_ARRAYS_SIZE, total_array_size());
|
||
|
||
ST_NUMBER(DID_ST_MAPPINGS, num_mappings);
|
||
ST_NUMBER(DID_ST_MAPPINGS_SIZE, total_mapping_size());
|
||
ST_NUMBER(DID_ST_HYBRID_MAPPINGS, num_dirty_mappings);
|
||
ST_NUMBER(DID_ST_HASH_MAPPINGS, num_hash_mappings);
|
||
|
||
ST_NUMBER(DID_ST_PROGS, total_num_prog_blocks + num_swapped
|
||
- num_unswapped);
|
||
ST_NUMBER(DID_ST_PROGS_SIZE, total_prog_block_size + total_bytes_swapped
|
||
- total_bytes_unswapped);
|
||
ST_NUMBER(DID_ST_PROGS_SWAPPED, num_swapped - num_unswapped);
|
||
ST_NUMBER(DID_ST_PROGS_SWAP_SIZE, total_bytes_swapped - total_bytes_unswapped);
|
||
|
||
ST_NUMBER(DID_ST_USER_RESERVE, reserved_user_size);
|
||
ST_NUMBER(DID_ST_MASTER_RESERVE, reserved_master_size);
|
||
ST_NUMBER(DID_ST_SYSTEM_RESERVE, reserved_system_size);
|
||
|
||
#ifdef COMM_STAT
|
||
ST_NUMBER(DID_ST_ADD_MESSAGE, add_message_calls);
|
||
ST_NUMBER(DID_ST_PACKETS, inet_packets);
|
||
ST_NUMBER(DID_ST_PACKET_SIZE, inet_volume);
|
||
ST_NUMBER(DID_ST_PACKETS_IN, inet_packets_in);
|
||
ST_NUMBER(DID_ST_PACKET_SIZE_IN, inet_volume_in);
|
||
#else
|
||
ST_NUMBER(DID_ST_ADD_MESSAGE, -1);
|
||
ST_NUMBER(DID_ST_PACKETS, -1);
|
||
ST_NUMBER(DID_ST_PACKET_SIZE, -1);
|
||
ST_NUMBER(DID_ST_PACKETS_IN, -1);
|
||
ST_NUMBER(DID_ST_PACKET_SIZE_IN, -1);
|
||
#endif
|
||
#ifdef APPLY_CACHE_STAT
|
||
ST_NUMBER(DID_ST_APPLY, apply_cache_hit+apply_cache_miss);
|
||
ST_NUMBER(DID_ST_APPLY_HITS, apply_cache_hit);
|
||
#else
|
||
ST_NUMBER(DID_ST_APPLY, -1);
|
||
ST_NUMBER(DID_ST_APPLY_HITS, -1);
|
||
#endif
|
||
|
||
#undef ST_NUMBER
|
||
#undef ST_DOUBLE
|
||
} /* dinfo_data_status() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
string_t *
|
||
check_valid_path (string_t *path, object_t *caller, string_t* call_fun, Bool writeflg)
|
||
|
||
/* Object <caller> will read resp. write (<writeflg>) the file <path>
|
||
* for the efun <call_fun>.
|
||
*
|
||
* Check the validity of the operation by calling master:valid_read() resp.
|
||
* valid_write().
|
||
*
|
||
* If the operation is valid, the path to use is returned (always without
|
||
* leading '/', the path "/" will be returned as ".").
|
||
*
|
||
* The result string has its own reference, but may be <path> again.
|
||
*
|
||
* If the operation is invalid, NULL is returned.
|
||
*/
|
||
|
||
{
|
||
svalue_t *v;
|
||
wiz_list_t *eff_user;
|
||
|
||
if (path)
|
||
push_ref_string(inter_sp, path);
|
||
else
|
||
push_number(inter_sp, 0);
|
||
|
||
if ( NULL != (eff_user = caller->eff_user) && NULL != eff_user->name)
|
||
push_ref_string(inter_sp, eff_user->name);
|
||
else
|
||
push_number(inter_sp, 0);
|
||
|
||
push_ref_string(inter_sp, call_fun);
|
||
push_ref_valid_object(inter_sp, caller, "check_valid_path");
|
||
if (writeflg)
|
||
v = apply_master(STR_VALID_WRITE, 4);
|
||
else
|
||
v = apply_master(STR_VALID_READ, 4);
|
||
|
||
if (!v || (v->type == T_NUMBER && v->u.number == 0))
|
||
return NULL;
|
||
|
||
if (v->type != T_STRING)
|
||
{
|
||
if (!path)
|
||
{
|
||
debug_message("%s master returned bogus filename\n", time_stamp());
|
||
return NULL;
|
||
}
|
||
(void)ref_mstring(path);
|
||
}
|
||
else if (v->u.str == path)
|
||
{
|
||
(void)ref_mstring(path);
|
||
}
|
||
else
|
||
{
|
||
path = ref_mstring(v->u.str);
|
||
}
|
||
|
||
if (get_txt(path)[0] == '/')
|
||
{
|
||
string_t *npath;
|
||
memsafe(npath = del_slash(path), mstrsize(path)-1
|
||
, "path for file operation");
|
||
free_mstring(path);
|
||
path = npath;
|
||
}
|
||
|
||
/* The string "/" will be converted to "." */
|
||
if (mstreq(path, STR_EMPTY))
|
||
{
|
||
free_mstring(path);
|
||
path = ref_mstring(STR_PERIOD);
|
||
}
|
||
|
||
if (legal_path(get_txt(path)))
|
||
{
|
||
return path;
|
||
}
|
||
|
||
/* Push the path onto the VM stack so that errorf() can free it */
|
||
push_string(inter_sp, path);
|
||
errorf("Illegal path '%s' for %s() by %s\n", get_txt(path), get_txt(call_fun)
|
||
, get_txt(caller->name));
|
||
return NULL;
|
||
} /* check_valid_path() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
init_empty_callback (callback_t *cb)
|
||
|
||
/* Initialize *<cb> to be an empty initialized callback.
|
||
* Use this to initialize callback structures which might be freed before
|
||
* completely filled in.
|
||
*/
|
||
|
||
{
|
||
cb->num_arg = 0;
|
||
cb->is_lambda = MY_FALSE;
|
||
cb->function.named.ob = NULL;
|
||
cb->function.named.name = NULL;
|
||
} /* init_empty_callback() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static INLINE void
|
||
free_callback_args (callback_t *cb)
|
||
|
||
/* Free the function arguments in the callback <cb>.
|
||
*/
|
||
|
||
{
|
||
svalue_t *dest;
|
||
int nargs;
|
||
|
||
nargs = cb->num_arg;
|
||
|
||
if (nargs == 1)
|
||
{
|
||
if (cb->arg.type != T_INVALID)
|
||
free_svalue(&(cb->arg));
|
||
}
|
||
else if (nargs > 1 && !cb->arg.x.extern_args)
|
||
{
|
||
dest = cb->arg.u.lvalue;
|
||
|
||
while (--nargs >= 0)
|
||
if (dest->type != T_INVALID)
|
||
free_svalue(dest++);
|
||
|
||
xfree(cb->arg.u.lvalue);
|
||
}
|
||
|
||
cb->arg.type = T_INVALID;
|
||
cb->num_arg = 0;
|
||
} /* free_callback_args() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
free_callback (callback_t *cb)
|
||
|
||
/* Free the data and references held by callback structure <cb>.
|
||
* The structure itself remains because usually it is embedded within
|
||
* another structure.
|
||
*
|
||
* Repeated calls for the same callback structure are legal.
|
||
*/
|
||
|
||
{
|
||
if (cb->is_lambda && cb->function.lambda.type != T_INVALID)
|
||
{
|
||
free_svalue(&(cb->function.lambda));
|
||
cb->function.lambda.type = T_INVALID;
|
||
}
|
||
else if (!(cb->is_lambda))
|
||
{
|
||
if (cb->function.named.ob)
|
||
free_object(cb->function.named.ob, "free_callback");
|
||
if (cb->function.named.name)
|
||
free_mstring(cb->function.named.name);
|
||
cb->function.named.ob = NULL;
|
||
cb->function.named.name = NULL;
|
||
}
|
||
|
||
free_callback_args(cb);
|
||
} /* free_callback() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static INLINE int
|
||
setup_callback_args (callback_t *cb, int nargs, svalue_t * args
|
||
, Bool delayed_callback)
|
||
|
||
/* Setup the function arguments in the callback <cb> to hold the <nargs>
|
||
* arguments starting from <args>. If <delayed_callback> is FALSE,
|
||
* the callback will happen within the current LPC cycle: no argument may be
|
||
* a protected lvalue, but normal lvalues are ok. If TRUE, the callback
|
||
* will happen at a later time: protected lvalues are ok, but not normal ones.
|
||
*
|
||
* The arguments are transferred into the callback structure.
|
||
*
|
||
* Result is -1 on success, or, when encountering an illegal argument,
|
||
* the index of the faulty argument (but even then all caller arguments
|
||
* have been transferred or freed).
|
||
*
|
||
* TODO: It should be possible to accept protected lvalues by careful
|
||
* TODO:: juggling of the protector structures. That, or rewriting the
|
||
* TODO:: lvalue system.
|
||
*/
|
||
|
||
{
|
||
svalue_t *dest;
|
||
|
||
cb->num_arg = nargs;
|
||
|
||
if (nargs < 1)
|
||
{
|
||
cb->arg.type = T_INVALID;
|
||
cb->num_arg = 0;
|
||
}
|
||
else
|
||
{
|
||
/* Transfer the arguments into the callback structure */
|
||
|
||
if (nargs > 1)
|
||
{
|
||
xallocate(dest, sizeof(*dest) * nargs, "callback structure");
|
||
cb->arg.type = T_LVALUE;
|
||
cb->arg.u.lvalue = dest;
|
||
cb->arg.x.extern_args = MY_FALSE;
|
||
}
|
||
else
|
||
dest = &(cb->arg);
|
||
|
||
while (--nargs >= 0)
|
||
{
|
||
Bool dontHandle = MY_FALSE;
|
||
|
||
if (args->type == T_LVALUE)
|
||
{
|
||
/* Check if we are allowed to handle the lvalues. */
|
||
Bool isProtected
|
||
= ( args->u.lvalue->type == T_PROTECTED_CHAR_LVALUE
|
||
|| args->u.lvalue->type == T_PROTECTED_STRING_RANGE_LVALUE
|
||
|| args->u.lvalue->type == T_PROTECTED_POINTER_RANGE_LVALUE
|
||
|| args->u.lvalue->type == T_PROTECTED_LVALUE
|
||
);
|
||
|
||
dontHandle = ( delayed_callback && !isProtected)
|
||
|| (!delayed_callback && isProtected)
|
||
;
|
||
}
|
||
|
||
if (dontHandle)
|
||
{
|
||
/* We don't handle the lvalue - abort the process.
|
||
* But to do that, we first have to free all
|
||
* remaining arguments from the caller.
|
||
*/
|
||
|
||
int error_index = cb->num_arg - nargs - 1;
|
||
|
||
do {
|
||
free_svalue(args++);
|
||
(dest++)->type = T_INVALID;
|
||
} while (--nargs >= 0);
|
||
|
||
free_callback_args(cb);
|
||
|
||
return error_index;
|
||
}
|
||
|
||
transfer_svalue_no_free(dest++, args++);
|
||
}
|
||
}
|
||
|
||
/* Success */
|
||
return -1;
|
||
} /* setup_callback_args() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
int
|
||
setup_function_callback ( callback_t *cb, object_t * ob, string_t * fun
|
||
, int nargs, svalue_t * args, Bool delayed_callback)
|
||
|
||
/* Setup the empty/uninitialized callback <cb> to hold a function
|
||
* call to <ob>:<fun> with the <nargs> arguments starting from <args>.
|
||
* If <delayed_callback> is FALSE, the callback will happen within the current
|
||
* LPC cycle: no argument may be a protected lvalue, but normal lvalues are
|
||
* ok. If TRUE, the callback will happen at a later time: protected lvalues
|
||
* are ok, but not normal ones.
|
||
*
|
||
* Both <ob> and <fun> are copied from the caller, but the arguments are
|
||
* adopted (taken away from the caller).
|
||
*
|
||
* Result is -1 on success, or, when encountering an illegal argument,
|
||
* the index of the faulty argument (but even then all caller arguments
|
||
* have been transferred or freed).
|
||
*/
|
||
|
||
{
|
||
int error_index;
|
||
|
||
cb->is_lambda = MY_FALSE;
|
||
cb->function.named.name = make_tabled_from(fun); /* for faster apply()s */
|
||
cb->function.named.ob = ref_object(ob, "callback");
|
||
|
||
error_index = setup_callback_args(cb, nargs, args, delayed_callback);
|
||
if (error_index >= 0)
|
||
{
|
||
free_object(cb->function.named.ob, "callback");
|
||
free_mstring(cb->function.named.name);
|
||
cb->function.named.ob = NULL;
|
||
cb->function.named.name = NULL;
|
||
}
|
||
|
||
return error_index;
|
||
} /* setup_function_callback() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
int
|
||
setup_closure_callback ( callback_t *cb, svalue_t *cl
|
||
, int nargs, svalue_t * args, Bool delayed_callback)
|
||
|
||
/* Setup the empty/uninitialized callback <cb> to hold a closure
|
||
* call to <cl> with the <nargs> arguments starting from <args>.
|
||
* If <delayed_callback> is FALSE, the callback will happen within the current
|
||
* LPC cycle: no argument may be a protected lvalue, but normal lvalues are
|
||
* ok. If TRUE, the callback will happen at a later time: protected lvalues
|
||
* are ok, but not normal ones.
|
||
*
|
||
* Both <cl> and the arguments are adopted (taken away from the caller).
|
||
*
|
||
* Result is -1 on success, or, when encountering an illegal argument,
|
||
* the index of the faulty argument (but even then all caller arguments
|
||
* have been transferred or freed).
|
||
*/
|
||
|
||
{
|
||
int error_index = -1;
|
||
|
||
cb->is_lambda = MY_TRUE;
|
||
transfer_svalue_no_free(&(cb->function.lambda), cl);
|
||
|
||
if (cb->function.lambda.x.closure_type == CLOSURE_UNBOUND_LAMBDA
|
||
|| cb->function.lambda.x.closure_type == CLOSURE_PRELIMINARY
|
||
)
|
||
{
|
||
/* Uncalleable closure */
|
||
error_index = 0;
|
||
free_svalue(&(cb->function.lambda));
|
||
cb->function.lambda.type = T_INVALID;
|
||
}
|
||
else
|
||
{
|
||
error_index = setup_callback_args(cb, nargs, args, delayed_callback);
|
||
if (error_index >= 0)
|
||
{
|
||
free_svalue(&(cb->function.lambda));
|
||
cb->function.lambda.type = T_INVALID;
|
||
error_index++;
|
||
}
|
||
}
|
||
|
||
return error_index;
|
||
} /* setup_closure_callback() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
int
|
||
setup_efun_callback_base ( callback_t *cb, svalue_t *args, int nargs
|
||
, Bool bNoObj)
|
||
|
||
/* Setup the empty/uninitialized callback <cb> with the <nargs>
|
||
* values starting at <args>. This function is used to implement the
|
||
* callbacks for efuns like map_array() and accepts these forms:
|
||
*
|
||
* (string fun)
|
||
* (string fun, mixed extra, ...) TODO: This form is UGLY!
|
||
* (closure cl, mixed extra, ...)
|
||
*
|
||
* If bNoObj is FALSE (the usual case), this form is also allowed:
|
||
*
|
||
* (string fun, string|object obj, mixed extra, ...)
|
||
*
|
||
* If the first argument is a string and the second neither an object
|
||
* nor a string, this_object() is used as object specification. Ditto
|
||
* if bNoObj is used.
|
||
*
|
||
* All arguments are adopted (taken away from the caller). Protected lvalues
|
||
* like &(i[0]) are not allowed as 'extra' arguments.
|
||
*
|
||
* Result is -1 on success, or, when encountering an illegal argument,
|
||
* the index of the faulty argument (but even then all caller arguments
|
||
* have been transferred or freed).
|
||
*
|
||
* This function is #defined to two macros:
|
||
*
|
||
* setup_efun_callback(cb,args,nargs) -> bNoObj == FALSE
|
||
* setup_efun_callback_noobj(cb,args,nargs) -> bNoObj == TRUE
|
||
*
|
||
* The no-object feature is to support old-fashioned efun
|
||
* unique_array().
|
||
*/
|
||
|
||
{
|
||
int error_index;
|
||
|
||
if (args[0].type == T_CLOSURE)
|
||
{
|
||
error_index = setup_closure_callback(cb, args, nargs-1, args+1, MY_FALSE);
|
||
}
|
||
else if (args[0].type == T_STRING)
|
||
{
|
||
object_t *ob;
|
||
int first_arg;
|
||
|
||
first_arg = 1;
|
||
|
||
if (nargs > 1)
|
||
{
|
||
if (bNoObj)
|
||
{
|
||
ob = current_object;
|
||
first_arg = 1;
|
||
}
|
||
else
|
||
{
|
||
if (args[1].type == T_OBJECT)
|
||
{
|
||
ob = args[1].u.ob;
|
||
first_arg = 2;
|
||
}
|
||
else if (args[1].type == T_STRING)
|
||
{
|
||
ob = get_object(args[1].u.str);
|
||
first_arg = 2;
|
||
}
|
||
else
|
||
{
|
||
/* TODO: It would be better to throw an error here */
|
||
ob = current_object;
|
||
first_arg = 1;
|
||
}
|
||
}
|
||
}
|
||
else
|
||
ob = current_object;
|
||
|
||
if (ob != NULL)
|
||
{
|
||
error_index = setup_function_callback(cb, ob, args[0].u.str
|
||
, nargs-first_arg
|
||
, args+first_arg
|
||
, MY_FALSE);
|
||
if (error_index >= 0)
|
||
error_index += first_arg;
|
||
}
|
||
else
|
||
{
|
||
/* We couldn't find an object to call, so we have
|
||
* to manually prepare the error condition.
|
||
*/
|
||
int i;
|
||
|
||
for (i = first_arg; i < nargs; i++)
|
||
free_svalue(args+i);
|
||
|
||
error_index = 1;
|
||
}
|
||
|
||
/* Free the function spec */
|
||
free_svalue(args);
|
||
if (first_arg > 1)
|
||
free_svalue(args+1);
|
||
}
|
||
else
|
||
{
|
||
/* We couldn't find anything to call, so we have
|
||
* to manually prepare the error condition.
|
||
*/
|
||
int i;
|
||
|
||
for (i = 0; i < nargs; i++)
|
||
free_svalue(args+i);
|
||
|
||
error_index = 0;
|
||
}
|
||
|
||
return error_index;
|
||
} /* setup_efun_callback_base() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
callback_change_object (callback_t *cb, object_t *obj)
|
||
|
||
/* Change the object the callback is bound to, if it is a function callback.
|
||
* A new reference is added to <obj>.
|
||
*/
|
||
|
||
{
|
||
object_t *old;
|
||
if (cb->is_lambda)
|
||
{
|
||
fatal("callback_change_object(): Must not be called with a closure callback.");
|
||
/* NOTREACHED */
|
||
return;
|
||
}
|
||
|
||
old = cb->function.named.ob;
|
||
cb->function.named.ob = ref_object(obj, "change callback");
|
||
|
||
if (old)
|
||
free_object(old, "change_callback");
|
||
} /* callback_change_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
object_t *
|
||
callback_object (callback_t *cb)
|
||
|
||
/* Return the object to call from the callback structure <cb>.
|
||
* If the object is destructed, return NULL.
|
||
*/
|
||
|
||
{
|
||
object_t *ob;
|
||
|
||
if (cb->is_lambda)
|
||
ob = !CLOSURE_MALLOCED(cb->function.lambda.x.closure_type)
|
||
? cb->function.lambda.u.ob
|
||
: cb->function.lambda.u.lambda->ob;
|
||
else
|
||
ob = cb->function.named.ob;
|
||
|
||
return check_object(ob);
|
||
} /* callback_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
execute_callback (callback_t *cb, int nargs, Bool keep, Bool toplevel)
|
||
|
||
/* Call the callback <cb> with the <nargs> arguments already pushed
|
||
* onto the stack. Result is a pointer to a static area with the
|
||
* result from the call.
|
||
*
|
||
* If an error occurs (the object to call has been destructed or can't
|
||
* be swapped in), NULL is returned.
|
||
*
|
||
* If <keep> is TRUE, the callback structure will not be freed.
|
||
* If <toplevel> is TRUE, the callback is called directly from
|
||
* the backend (as opposed to from a running program) which makes
|
||
* certain extra setups for current_object and current_prog necessary.
|
||
*
|
||
* This function is #defined to two macros:
|
||
*
|
||
* apply_callback(cb,nargs): call a callback from a running program,
|
||
* the callback is kept.
|
||
* backend_callback(cb,nargs): call a callback from the backend
|
||
* and free it afterwards.
|
||
*/
|
||
|
||
{
|
||
object_t *ob;
|
||
int num_arg;
|
||
|
||
ob = callback_object(cb);
|
||
if (!ob
|
||
#ifdef USE_SWAP
|
||
|| (O_PROG_SWAPPED(ob) && load_ob_from_swap(ob) < 0)
|
||
#endif
|
||
)
|
||
{
|
||
while (nargs-- > 0)
|
||
free_svalue(inter_sp--);
|
||
free_callback(cb);
|
||
return NULL;
|
||
}
|
||
|
||
/* Push the arguments, if any, onto the stack */
|
||
|
||
num_arg = cb->num_arg;
|
||
|
||
if (num_arg)
|
||
{
|
||
svalue_t * argp;
|
||
int j;
|
||
|
||
if (num_arg > 1)
|
||
argp = cb->arg.u.lvalue;
|
||
else
|
||
argp = &(cb->arg);
|
||
|
||
for (j = 0; j < num_arg; j++, argp++)
|
||
{
|
||
inter_sp++;
|
||
if (destructed_object_ref(argp))
|
||
{
|
||
*inter_sp = const0;
|
||
assign_svalue(argp, &const0);
|
||
}
|
||
else if (keep)
|
||
assign_svalue_no_free(inter_sp, argp);
|
||
else
|
||
transfer_svalue_no_free(inter_sp, argp);
|
||
}
|
||
|
||
}
|
||
|
||
if (!keep)
|
||
{
|
||
/* The arguments are gone from the callback */
|
||
|
||
if (cb->num_arg > 1)
|
||
xfree(cb->arg.u.lvalue);
|
||
cb->num_arg = 0;
|
||
cb->arg.type = T_INVALID;
|
||
}
|
||
|
||
/* Now call the function */
|
||
|
||
if (toplevel)
|
||
current_object = ob; /* Need something valid here */
|
||
|
||
if (cb->is_lambda)
|
||
{
|
||
if (toplevel
|
||
&& cb->function.lambda.x.closure_type < CLOSURE_SIMUL_EFUN
|
||
&& cb->function.lambda.x.closure_type >= CLOSURE_EFUN)
|
||
{
|
||
/* efun, operator or sefun closure called from the backend:
|
||
* we need the program for a proper traceback. We made sure
|
||
* before that the program has been swapped in.
|
||
*/
|
||
current_prog = ob->prog;
|
||
}
|
||
|
||
call_lambda(&(cb->function.lambda), num_arg + nargs);
|
||
transfer_svalue(&apply_return_value, inter_sp);
|
||
inter_sp--;
|
||
}
|
||
else
|
||
{
|
||
if (toplevel)
|
||
tracedepth = 0;
|
||
|
||
if (!sapply(cb->function.named.name, ob, num_arg + nargs))
|
||
transfer_svalue(&apply_return_value, &const0);
|
||
}
|
||
|
||
if (!keep)
|
||
{
|
||
/* Free the remaining information from the callback structure */
|
||
free_callback(cb);
|
||
}
|
||
|
||
/* Return the result */
|
||
return &apply_return_value;
|
||
} /* execute_callback() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
#ifdef USE_PARANOIA
|
||
|
||
void
|
||
count_callback_extra_refs (callback_t *cb)
|
||
|
||
/* Count all the refs in the callback to verify the normal refcounting. */
|
||
|
||
{
|
||
if (!cb->is_lambda)
|
||
count_extra_ref_in_object(cb->function.named.ob);
|
||
else
|
||
count_extra_ref_in_vector(&cb->function.lambda, 1);
|
||
if (cb->num_arg == 1)
|
||
count_extra_ref_in_vector(&(cb->arg), 1);
|
||
else if (cb->num_arg > 1)
|
||
count_extra_ref_in_vector(cb->arg.u.lvalue, (size_t)cb->num_arg);
|
||
} /* count_callback_extra_refs() */
|
||
|
||
#endif /* USE_PARANOIA */
|
||
|
||
#ifdef GC_SUPPORT
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
clear_ref_in_callback (callback_t *cb)
|
||
|
||
/* GC support: clear the refs in the memory held by the callback
|
||
* structure (but not of the structure itself!)
|
||
*/
|
||
|
||
{
|
||
if (cb->num_arg == 1)
|
||
clear_ref_in_vector(&(cb->arg), 1);
|
||
else if (cb->num_arg > 1)
|
||
{
|
||
clear_ref_in_vector(cb->arg.u.lvalue, (size_t)cb->num_arg);
|
||
if (!cb->arg.x.extern_args)
|
||
clear_memory_reference(cb->arg.u.lvalue);
|
||
}
|
||
|
||
if (cb->is_lambda)
|
||
clear_ref_in_vector(&(cb->function.lambda), 1);
|
||
else
|
||
{
|
||
#ifdef DEBUG
|
||
if (!callback_object(cb))
|
||
fatal("GC run on callback with stale object.\n");
|
||
#endif
|
||
clear_object_ref(cb->function.named.ob);
|
||
}
|
||
} /* clear_ref_in_callback() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
count_ref_in_callback (callback_t *cb)
|
||
|
||
/* GC support: count the refs in the memory held by the callback
|
||
* structure (but not of the structure itself!)
|
||
*/
|
||
|
||
{
|
||
if (cb->num_arg == 1)
|
||
count_ref_in_vector(&(cb->arg), 1);
|
||
else if (cb->num_arg > 1)
|
||
{
|
||
count_ref_in_vector(cb->arg.u.lvalue, (size_t)cb->num_arg);
|
||
if (!cb->arg.x.extern_args)
|
||
note_malloced_block_ref(cb->arg.u.lvalue);
|
||
}
|
||
|
||
#ifdef DEBUG
|
||
if (!callback_object(cb))
|
||
fatal("GC run on callback with stale object.\n");
|
||
#endif
|
||
if (cb->is_lambda)
|
||
count_ref_in_vector(&(cb->function.lambda), 1);
|
||
else
|
||
{
|
||
cb->function.named.ob->ref++;
|
||
count_ref_from_string(cb->function.named.name);
|
||
}
|
||
} /* count_ref_in_callback() */
|
||
|
||
#endif
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
init_driver_hooks()
|
||
|
||
/* Init the driver hooks.
|
||
*/
|
||
|
||
{
|
||
int i;
|
||
|
||
for (i = NUM_DRIVER_HOOKS; --i >= 0; )
|
||
{
|
||
put_number(driver_hook + i, 0);
|
||
}
|
||
} /* init_driver_hooks() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
Bool
|
||
match_string (const char * match, const char * str, mp_int len)
|
||
|
||
/* Test if the string <str> of length <len> matches the pattern <match>.
|
||
* Allowed wildcards are
|
||
* *: matches any sequence
|
||
* ?: matches any single character
|
||
* \: escapes the following wildcard
|
||
*
|
||
* The function is used by the compiler for inheritance specs, and by
|
||
* f_get_dir().
|
||
* TODO: Another utils.c candidate.
|
||
*/
|
||
|
||
{
|
||
/* Loop over match and str */
|
||
for (;;)
|
||
{
|
||
/* Act on the current match character */
|
||
switch(*match)
|
||
{
|
||
case '?':
|
||
if (--len < 0)
|
||
return MY_FALSE;
|
||
str++;
|
||
match++;
|
||
continue;
|
||
|
||
case '*':
|
||
{
|
||
char *str2;
|
||
mp_int matchlen;
|
||
|
||
for (;;)
|
||
{
|
||
switch (*++match)
|
||
{
|
||
case '\0':
|
||
return len >= 0;
|
||
case '?':
|
||
--len;
|
||
str++;
|
||
case '*':
|
||
continue;
|
||
case '\\':
|
||
match++;
|
||
default:
|
||
break;
|
||
}
|
||
break;
|
||
}
|
||
|
||
if (len <= 0)
|
||
return MY_FALSE;
|
||
|
||
str2 = strpbrk(match + 1, "?*\\");
|
||
if (!str2)
|
||
{
|
||
if ( (matchlen = strlen(match)) > len)
|
||
return MY_FALSE;
|
||
return strncmp(match, str + len - matchlen, matchlen) == 0;
|
||
}
|
||
else
|
||
{
|
||
matchlen = str2 - match;
|
||
}
|
||
/* matchlen >= 1 */
|
||
if ((len -= matchlen) >= 0) do
|
||
{
|
||
if ( !(str2 = xmemmem(str, len + matchlen, match, matchlen)) )
|
||
return MY_FALSE;
|
||
len -= str2 - str;
|
||
if (match_string(match + matchlen, str2 + matchlen, len))
|
||
return MY_TRUE;
|
||
str = str2 + 1;
|
||
} while (--len >= 0);
|
||
return MY_FALSE;
|
||
}
|
||
|
||
case '\0':
|
||
return len == 0;
|
||
|
||
case '\\':
|
||
match++;
|
||
if (*match == '\0')
|
||
return MY_FALSE;
|
||
/* Fall through ! */
|
||
|
||
default:
|
||
if (--len >= 0 && *match == *str)
|
||
{
|
||
match++;
|
||
str++;
|
||
continue;
|
||
}
|
||
return MY_FALSE;
|
||
} /* switch(*match) */
|
||
} /* for(;;) */
|
||
} /* match_string() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
void
|
||
print_svalue (svalue_t *arg)
|
||
|
||
/* Print the value <arg> to the interactive user (exception: strings
|
||
* are also written to non-interactive command_givers via tell_npc()).
|
||
* The function is called for the efun write() and from
|
||
* interpret:do_trace_call().
|
||
*
|
||
* The function can only print scalar values - arrays, mappings and
|
||
* closures are only hinted at.
|
||
*/
|
||
|
||
{
|
||
if (arg == NULL)
|
||
{
|
||
add_message("<NULL>");
|
||
}
|
||
else if (arg->type == T_STRING)
|
||
{
|
||
interactive_t *ip;
|
||
|
||
/* Strings sent to monsters are now delivered */
|
||
if (command_giver && (command_giver->flags & O_ENABLE_COMMANDS)
|
||
&& !(O_SET_INTERACTIVE(ip, command_giver)) )
|
||
{
|
||
tell_npc(command_giver, arg->u.str);
|
||
}
|
||
else
|
||
{
|
||
add_message(FMT_STRING, arg->u.str);
|
||
}
|
||
}
|
||
else if (arg->type == T_OBJECT)
|
||
add_message("OBJ(%s)", get_txt(arg->u.ob->name));
|
||
else if (arg->type == T_NUMBER)
|
||
add_message("%"PRIdPINT, arg->u.number);
|
||
else if (arg->type == T_FLOAT)
|
||
{
|
||
char buff[120];
|
||
|
||
snprintf(buff, sizeof(buff), "%g", READ_DOUBLE( arg ) );
|
||
add_message(buff);
|
||
}
|
||
else if (arg->type == T_POINTER)
|
||
add_message("<ARRAY>");
|
||
else if (arg->type == T_MAPPING)
|
||
add_message("<MAPPING>");
|
||
else if (arg->type == T_CLOSURE)
|
||
add_message("<CLOSURE>");
|
||
else
|
||
add_message("<OTHER:%"PRIdPHINT">", arg->type);
|
||
} /* print_svalue() */
|
||
|
||
/*=========================================================================*/
|
||
|
||
/* EFUNS */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_clone_object (svalue_t * sp)
|
||
|
||
/* EFUN clone_object()
|
||
*
|
||
* object clone_object(string name)
|
||
* object clone_object(object template)
|
||
*
|
||
* Clone a new object from definition <name>, or alternatively from
|
||
* the object <template>. In both cases, the new object is given an
|
||
* unique name and returned.
|
||
*/
|
||
|
||
{
|
||
object_t *ob;
|
||
|
||
/* Get the argument and clone the object */
|
||
if (sp->type == T_STRING)
|
||
{
|
||
ob = clone_object(sp->u.str);
|
||
}
|
||
else
|
||
{
|
||
ob = clone_object(sp->u.ob->load_name);
|
||
}
|
||
|
||
free_svalue(sp);
|
||
|
||
if (ob)
|
||
{
|
||
put_ref_object(sp, ob, "F_CLONE_OBJECT");
|
||
}
|
||
else
|
||
put_number(sp, 0);
|
||
|
||
return sp;
|
||
} /* f_clone_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_destruct (svalue_t * sp)
|
||
|
||
/* EFUN destruct()
|
||
*
|
||
* void destruct(object ob)
|
||
*
|
||
* Completely destroy and remove object ob (if not already done so).
|
||
* After the call to destruct(), no global variables will exist any
|
||
* longer, only local ones, and arguments.
|
||
*
|
||
* If an object self-destructs, it will not immediately terminate
|
||
* execution. If the efun this_object() will be called by the
|
||
* destructed object, the result will be 0.
|
||
*
|
||
* The efun accepts destructed objects as argument (which appear
|
||
* as the number 0) and the simply acts as a no-op in that case.
|
||
*
|
||
* Internally, the object is not destructed immediately, but
|
||
* instead put into a list and finally destructed after the
|
||
* current execution has ended.
|
||
*/
|
||
|
||
{
|
||
if (T_NUMBER != sp->type || sp->u.number)
|
||
{
|
||
if (sp->type != T_OBJECT)
|
||
efun_arg_error(1, T_OBJECT, sp->type, sp);
|
||
destruct_object(sp);
|
||
}
|
||
free_svalue(sp);
|
||
sp--;
|
||
|
||
return sp;
|
||
} /* f_destruct() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_find_object (svalue_t *sp)
|
||
|
||
/* EFUN find_object()
|
||
*
|
||
* object find_object(string str)
|
||
*
|
||
* Find an object with the file_name str. If the object isn't loaded,
|
||
* it will not be found.
|
||
*/
|
||
|
||
{
|
||
object_t *ob;
|
||
|
||
ob = find_object(sp->u.str);
|
||
free_svalue(sp);
|
||
if (ob)
|
||
put_ref_object(sp, ob, "find_object");
|
||
else
|
||
put_number(sp, 0);
|
||
|
||
return sp;
|
||
} /* f_find_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_load_object (svalue_t *sp)
|
||
|
||
/* EFUN load_object()
|
||
*
|
||
* object load_object(string name)
|
||
*
|
||
* Load the object from the file <name> and return it. If the
|
||
* object already exists, just return it.
|
||
*
|
||
* This efun can be used only to load blueprints - for clones, use
|
||
* the efun clone_object().
|
||
*/
|
||
|
||
{
|
||
object_t *ob;
|
||
|
||
ob = get_object(sp->u.str);
|
||
free_svalue(sp);
|
||
if (ob)
|
||
put_ref_object(sp, ob, "F_LOAD_OBJECT");
|
||
else
|
||
put_number(sp, 0);
|
||
return sp;
|
||
} /* f_load_object() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
#ifdef USE_SHADOWING
|
||
|
||
static Bool
|
||
validate_shadowing (object_t *ob)
|
||
|
||
/* May current_object shadow object 'ob'? We perform a number of tests
|
||
* including calling master:query_allow_shadow().
|
||
* TODO: Move all shadow functions into a separate file.
|
||
*/
|
||
|
||
{
|
||
int i, j;
|
||
object_t *cob;
|
||
program_t *shadow, *victim;
|
||
svalue_t *ret;
|
||
|
||
cob = current_object;
|
||
shadow = cob->prog;
|
||
|
||
if (cob->flags & O_DESTRUCTED)
|
||
return MY_FALSE;
|
||
|
||
#ifdef USE_SWAP
|
||
if (O_PROG_SWAPPED(ob))
|
||
if (load_ob_from_swap(ob) < 0)
|
||
errorf("Out of memory: unswap object '%s'\n", get_txt(ob->name));
|
||
#endif
|
||
|
||
victim = ob->prog;
|
||
|
||
if (victim->flags & P_NO_SHADOW)
|
||
errorf("shadow '%s' on '%s': Can't shadow a 'no_shadow' program.\n"
|
||
, get_txt(cob->name), get_txt(ob->name));
|
||
|
||
if (cob->flags & O_SHADOW)
|
||
{
|
||
shadow_t *shadow_sent = O_GET_SHADOW(cob);
|
||
|
||
if (shadow_sent->shadowing)
|
||
errorf("shadow '%s' on '%s': Already shadowing.\n"
|
||
, get_txt(cob->name), get_txt(ob->name));
|
||
if (shadow_sent->shadowed_by)
|
||
errorf("shadow '%s' on '%s': Can't shadow when shadowed.\n"
|
||
, get_txt(cob->name), get_txt(ob->name));
|
||
}
|
||
|
||
#ifdef USE_INVENTORIES
|
||
if (cob->super)
|
||
errorf("shadow '%s' on '%s': The shadow resides inside another object ('%s').\n"
|
||
, get_txt(cob->name), get_txt(ob->name)
|
||
, get_txt(cob->super->name));
|
||
#endif
|
||
|
||
if (ob->flags & O_SHADOW && O_GET_SHADOW(ob)->shadowing)
|
||
errorf("shadow '%s' on '%s': Can't shadow a shadow.\n"
|
||
, get_txt(cob->name), get_txt(ob->name));
|
||
|
||
if (ob == cob)
|
||
errorf("shadow '%s' on '%s': Can't shadow self.\n"
|
||
, get_txt(cob->name), get_txt(ob->name));
|
||
|
||
/* Make sure that we don't shadow 'nomask' functions.
|
||
*/
|
||
for (i = shadow->num_function_names; --i >= 0; )
|
||
{
|
||
funflag_t flags;
|
||
string_t *name;
|
||
program_t *progp;
|
||
|
||
j = shadow->function_names[i];
|
||
flags = shadow->functions[j];
|
||
progp = shadow;
|
||
while (flags & NAME_INHERITED)
|
||
{
|
||
inherit_t *inheritp;
|
||
|
||
inheritp = &progp->inherit[flags & INHERIT_MASK];
|
||
j -= inheritp->function_index_offset;
|
||
progp = inheritp->prog;
|
||
flags = progp->functions[j];
|
||
}
|
||
|
||
memcpy(&name, FUNCTION_NAMEP(progp->program + (flags & FUNSTART_MASK))
|
||
, sizeof name
|
||
);
|
||
|
||
if ( (j = find_function(name, victim)) >= 0
|
||
&& victim->functions[j] & TYPE_MOD_NO_MASK )
|
||
{
|
||
errorf("shadow '%s' on '%s': Illegal to shadow 'nomask' function '%s'.\n"
|
||
, get_txt(ob->name), get_txt(cob->name), get_txt(name));
|
||
}
|
||
}
|
||
|
||
push_ref_object(inter_sp, ob, "shadow");
|
||
ret = apply_master(STR_QUERY_SHADOW, 1);
|
||
|
||
if (!((ob->flags|cob->flags) & O_DESTRUCTED)
|
||
&& ret && !(ret->type == T_NUMBER && ret->u.number == 0))
|
||
{
|
||
return MY_TRUE;
|
||
}
|
||
|
||
return MY_FALSE;
|
||
} /* validate_shadowing() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_shadow (svalue_t *sp)
|
||
|
||
/* EFUN shadow()
|
||
*
|
||
* object shadow(object ob, int flag)
|
||
*
|
||
* If flag is non-zero then the current object will shadow ob. If
|
||
* flag is 0 then either 0 will be returned or the object that is
|
||
* shadowing ob.
|
||
*
|
||
* The calling object must be permitted by the master object to
|
||
* do the shadowing. In most installations, an object that
|
||
* defines the function query_prevent_shadow() to return 1
|
||
* can't be shadowed, and the shadow() function will return 0
|
||
* instead of ob.
|
||
*
|
||
* shadow() also fails if the calling object tries to shadow
|
||
* a function that was defined as ``nomask'', if the program was
|
||
* compiled with the #pragma no_shadow, or if the calling
|
||
* object is already shadowing, is being shadowed, or has an
|
||
* environment. Also the target ob must not be shadowing
|
||
* something else.
|
||
*
|
||
* If an object A shadows an object B then all call_other() to B
|
||
* will be redirected to A. If object A has not defined the
|
||
* function, then the call will be passed to B. There is only on
|
||
* object that can call functions in B with call_other(), and
|
||
* that is A. Not even object B can call_other() itself. All
|
||
* normal (internal) function calls inside B will however remain
|
||
* internal to B.
|
||
*/
|
||
|
||
{
|
||
object_t *ob;
|
||
|
||
/* Get the arguments */
|
||
sp--;
|
||
ob = sp->u.ob;
|
||
deref_object(ob, "shadow");
|
||
|
||
if (sp[1].u.number == 0)
|
||
{
|
||
/* Just look for a possible shadow */
|
||
ob = (ob->flags & O_SHADOW) ? O_GET_SHADOW(ob)->shadowed_by : NULL;
|
||
if (ob)
|
||
sp->u.ob = ref_object(ob, "shadow");
|
||
else
|
||
put_number(sp, 0);
|
||
return sp;
|
||
}
|
||
|
||
sp->type = T_NUMBER; /* validate_shadowing might destruct ob */
|
||
assign_eval_cost();
|
||
inter_sp = sp;
|
||
if (validate_shadowing(ob))
|
||
{
|
||
/* Shadowing allowed */
|
||
|
||
shadow_t *shadow_sent, *co_shadow_sent;
|
||
|
||
/* The shadow is entered first in the chain.
|
||
*/
|
||
assert_shadow_sent(ob);
|
||
if (O_IS_INTERACTIVE(ob))
|
||
O_GET_INTERACTIVE(ob)->catch_tell_activ = MY_TRUE;
|
||
shadow_sent = O_GET_SHADOW(ob);
|
||
|
||
while (shadow_sent->shadowed_by)
|
||
{
|
||
ob = shadow_sent->shadowed_by;
|
||
shadow_sent = O_GET_SHADOW(ob);
|
||
}
|
||
|
||
assert_shadow_sent(current_object);
|
||
co_shadow_sent = O_GET_SHADOW(current_object);
|
||
|
||
co_shadow_sent->shadowing = ob;
|
||
shadow_sent->shadowed_by = current_object;
|
||
put_ref_object(sp, ob, "shadow");
|
||
return sp;
|
||
}
|
||
|
||
/* Shadowing not allowed */
|
||
put_number(sp, 0);
|
||
return sp;
|
||
} /* f_shadow() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_query_shadowing (svalue_t *sp)
|
||
|
||
/* EFUN query_shadowing()
|
||
*
|
||
* object query_shadowing (object obj)
|
||
*
|
||
* The function returns the object which <obj> is currently
|
||
* shadowing, or 0 if <obj> is not a shadow.
|
||
*/
|
||
|
||
{
|
||
|
||
object_t *ob;
|
||
|
||
ob = sp->u.ob;
|
||
deref_object(ob, "shadow");
|
||
ob = (ob->flags & O_SHADOW) ? O_GET_SHADOW(ob)->shadowing : NULL;
|
||
if (ob)
|
||
sp->u.ob = ref_object(ob, "shadow");
|
||
else
|
||
put_number(sp, 0);
|
||
|
||
return sp;
|
||
} /* f_query_shadowing() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_unshadow (svalue_t *sp)
|
||
|
||
/* EFUN unshadow()
|
||
*
|
||
* void unshadow(void)
|
||
*
|
||
* The calling object stops shadowing any other object.
|
||
* If the calling object is being shadowed, that is also stopped.
|
||
*/
|
||
|
||
{
|
||
shadow_t *shadow_sent, *shadowing_sent;
|
||
object_t *shadowing, *shadowed_by;
|
||
|
||
if (current_object->flags & O_SHADOW
|
||
&& NULL != (shadowing = (shadow_sent = O_GET_SHADOW(current_object))->shadowing) )
|
||
{
|
||
shadowing_sent = O_GET_SHADOW(shadowing);
|
||
|
||
/* Our victim is now shadowed by our shadow */
|
||
shadowed_by = shadow_sent->shadowed_by;
|
||
shadowing_sent->shadowed_by = shadowed_by;
|
||
|
||
if ( NULL != shadowed_by )
|
||
{
|
||
/* Inform our shadow about its new victim */
|
||
O_GET_SHADOW(shadowed_by)->shadowing = shadow_sent->shadowing;
|
||
}
|
||
else
|
||
{
|
||
/* Our victim is no longer shadowed, so maybe it
|
||
* doesn't need its shadow sentence anymore.
|
||
*/
|
||
#ifdef USE_ACTIONS
|
||
remove_shadow_actions(current_object, shadowing);
|
||
#endif
|
||
check_shadow_sent(shadowing);
|
||
}
|
||
|
||
shadow_sent->shadowed_by = NULL;
|
||
shadow_sent->shadowing = NULL;
|
||
|
||
check_shadow_sent(current_object);
|
||
}
|
||
|
||
return sp;
|
||
} /* f_unshadow() */
|
||
#endif
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_set_driver_hook (svalue_t *sp)
|
||
|
||
/* EFUN set_driver_hook()
|
||
*
|
||
* void set_driver_hook(int what, closure arg)
|
||
* void set_driver_hook(int what, string arg)
|
||
* void set_driver_hook(int what, string * arg)
|
||
*
|
||
* This privileged efun sets the driver hook 'what' (values are
|
||
* defined in /sys/driverhooks.h) to 'arg'.
|
||
* The exact meanings and types of 'arg' depend of the hook set.
|
||
* To remove a hook, set 'arg' to 0.
|
||
*
|
||
* Raises a privilege violation ("set_driver_hook", this_object, what).
|
||
*
|
||
* See hooks(C) for a detailed discussion.
|
||
*/
|
||
|
||
{
|
||
p_int n;
|
||
svalue_t old;
|
||
|
||
/* Get the arguments */
|
||
n = sp[-1].u.number;
|
||
|
||
if (n < 0 || n >= NUM_DRIVER_HOOKS)
|
||
{
|
||
errorf("Bad hook number: %"PRIdPINT", expected 0..%ld\n"
|
||
, n, (long)NUM_DRIVER_HOOKS-1);
|
||
/* NOTREACHED */
|
||
return sp;
|
||
}
|
||
|
||
/* Legal call? */
|
||
if (!privilege_violation(STR_SET_DRIVER_HOOK, sp-1, sp))
|
||
{
|
||
free_svalue(sp);
|
||
return sp - 2;
|
||
}
|
||
|
||
old = driver_hook[n]; /* Remember this for freeing */
|
||
|
||
/* Check the type of the hook and set it if ok
|
||
*/
|
||
switch(sp->type)
|
||
{
|
||
case T_NUMBER:
|
||
if (sp->u.number == 0)
|
||
{
|
||
put_number(driver_hook + n, 0);
|
||
break;
|
||
}
|
||
else if (n == H_REGEXP_PACKAGE)
|
||
{
|
||
if (sp->u.number != RE_PCRE
|
||
&& sp->u.number != RE_TRADITIONAL
|
||
)
|
||
{
|
||
errorf("Bad value for hook %"PRIdPINT": got 0x%"PRIxPINT
|
||
", expected RE_PCRE (0x%lx) or RE_TRADITIONAL (0x%lx).\n"
|
||
, n, sp->u.number
|
||
, (long)RE_PCRE, (long)RE_TRADITIONAL
|
||
);
|
||
break;
|
||
}
|
||
goto default_test;
|
||
}
|
||
else
|
||
{
|
||
errorf("Bad value for hook %"PRIdPINT": got number, expected %s or 0.\n"
|
||
, n
|
||
, efun_arg_typename(hook_type_map[n]));
|
||
break;
|
||
}
|
||
break;
|
||
|
||
case T_STRING:
|
||
{
|
||
string_t *str;
|
||
|
||
if ( !((1 << T_STRING) & hook_type_map[n]) )
|
||
errorf("Bad value for hook %"PRIdPINT": got string, expected %s.\n"
|
||
, n
|
||
, efun_arg_typename(hook_type_map[n]));
|
||
|
||
str = make_tabled_from(sp->u.str); /* for faster apply()s */
|
||
put_string(driver_hook + n, str);
|
||
free_svalue(sp);
|
||
if (n == H_NOECHO)
|
||
mudlib_telopts();
|
||
break;
|
||
}
|
||
|
||
case T_MAPPING:
|
||
if (!sp->u.map->num_values
|
||
|| sp->u.map->ref != 1 /* add_to_mapping() could zero num_values */)
|
||
{
|
||
errorf("Bad value for hook %"PRIdPINT": mapping is empty "
|
||
"or has other references.\n", n);
|
||
return sp;
|
||
}
|
||
goto default_test;
|
||
|
||
case T_POINTER:
|
||
{
|
||
vector_t *v = sp->u.vec;
|
||
|
||
if (v->ref > 1)
|
||
{
|
||
/* We need a genuine copy of the array */
|
||
deref_array(v);
|
||
sp->u.vec = v = slice_array(v, 0, VEC_SIZE(v)-1);
|
||
}
|
||
|
||
if (n == H_INCLUDE_DIRS)
|
||
{
|
||
inter_sp = sp;
|
||
set_inc_list(v);
|
||
}
|
||
goto default_test;
|
||
}
|
||
|
||
case T_CLOSURE:
|
||
if (sp->x.closure_type == CLOSURE_UNBOUND_LAMBDA
|
||
&& sp->u.lambda->ref == 1)
|
||
{
|
||
driver_hook[n] = *sp;
|
||
driver_hook[n].x.closure_type = CLOSURE_LAMBDA;
|
||
driver_hook[n].u.lambda->ob = ref_object(master_ob, "hook closure");
|
||
if (n == H_NOECHO)
|
||
{
|
||
mudlib_telopts();
|
||
}
|
||
break;
|
||
}
|
||
else if (!CLOSURE_IS_LFUN(sp->x.closure_type))
|
||
{
|
||
errorf("Bad value for hook %"PRIdPINT": unbound lambda or "
|
||
"lfun closure expected.\n", n);
|
||
}
|
||
/* FALLTHROUGH */
|
||
|
||
default:
|
||
default_test:
|
||
if ( !((1 << sp->type) & hook_type_map[n]) )
|
||
{
|
||
errorf("Bad value for hook %"PRIdPINT": got %s, expected %s.\n"
|
||
, n, typename(sp->type), efun_arg_typename(hook_type_map[n]));
|
||
break; /* flow control hint */
|
||
}
|
||
|
||
driver_hook[n] = *sp;
|
||
|
||
if (n == H_NOECHO)
|
||
{
|
||
mudlib_telopts();
|
||
}
|
||
break;
|
||
}
|
||
|
||
if (old.type != T_NUMBER)
|
||
free_svalue(&old);
|
||
|
||
return sp - 2;
|
||
} /* f_set_driver_hook() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_write (svalue_t *sp)
|
||
|
||
/* EFUN write()
|
||
*
|
||
* void write (mixed msg)
|
||
*
|
||
* Write out something to the current user. What exactly will
|
||
* be printed in the end depends of the type of msg.
|
||
*
|
||
* If it is a string or a number then just prints it out.
|
||
*
|
||
* If it is an object then the object will be printed in the
|
||
* form: "OBJ("+file_name((object)mix)+")"
|
||
*
|
||
* If it is an array just "<ARRAY>" will be printed.
|
||
* If it is a mapping just "<MAPPING>" will be printed.
|
||
* If it is a closure just "<CLOSURE>" will be printed.
|
||
*
|
||
* If the write() function is invoked by a command of an living
|
||
* but not interactive object and the given argument is a string
|
||
* then the lfun catch_tell() of the living will be invoked with
|
||
* the message as argument.
|
||
*/
|
||
|
||
{
|
||
#ifdef USE_SHADOWING
|
||
object_t *save_command_giver = command_giver;
|
||
|
||
if (!command_giver
|
||
&& current_object->flags & O_SHADOW
|
||
&& O_GET_SHADOW(current_object)->shadowing)
|
||
{
|
||
command_giver = current_object;
|
||
}
|
||
|
||
if (command_giver)
|
||
{
|
||
/* Send the message to the first object in the shadow list */
|
||
if (command_giver->flags & O_SHADOW)
|
||
while( O_GET_SHADOW(command_giver)->shadowing )
|
||
command_giver = O_GET_SHADOW(command_giver)->shadowing;
|
||
}
|
||
#endif
|
||
|
||
print_svalue(sp);
|
||
#ifdef USE_SHADOWING
|
||
command_giver = check_object(save_command_giver);
|
||
#endif
|
||
|
||
free_svalue(sp); sp--;
|
||
|
||
return sp;
|
||
} /* f_write() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static void
|
||
set_single_limit ( struct limits_context_s * result
|
||
, int limit
|
||
, svalue_t *svp
|
||
)
|
||
|
||
/* Set the limit #<limit> in *<result> to the value in <svp>.
|
||
*
|
||
* If the function encounters illegal limit tags or values, it throws
|
||
* an error.
|
||
*/
|
||
|
||
{
|
||
static char * limitnames[] = { "LIMIT_EVAL", "LIMIT_ARRAY", "LIMIT_MAPPING"
|
||
, "LIMIT_BYTE", "LIMIT_FILE", "LIMIT_COST" };
|
||
|
||
p_int val;
|
||
|
||
if (svp->type != T_NUMBER)
|
||
errorf("Illegal %s value: got a %s, expected a number\n"
|
||
, limitnames[limit], typename(svp[limit].type));
|
||
|
||
val = svp->u.number;
|
||
|
||
if (limit == LIMIT_COST)
|
||
{
|
||
if (val == LIMIT_DEFAULT)
|
||
result->use_cost = DEF_USE_EVAL_COST;
|
||
else if (val != LIMIT_KEEP)
|
||
result->use_cost = val;
|
||
}
|
||
else
|
||
{
|
||
if (val >= 0)
|
||
{
|
||
switch(limit)
|
||
{
|
||
case LIMIT_EVAL: result->max_eval = val; break;
|
||
case LIMIT_ARRAY: result->max_array = val; break;
|
||
case LIMIT_MAPPING_KEYS: result->max_map_keys = val; break;
|
||
case LIMIT_MAPPING_SIZE: result->max_mapping = val; break;
|
||
case LIMIT_BYTE: result->max_byte = val; break;
|
||
case LIMIT_FILE: result->max_file = val; break;
|
||
case LIMIT_CALLOUTS: result->max_callouts = val; break;
|
||
default: errorf("Unimplemented limit #%d\n", limit);
|
||
}
|
||
}
|
||
else if (val == LIMIT_DEFAULT)
|
||
{
|
||
switch(limit)
|
||
{
|
||
case LIMIT_EVAL: result->max_eval = def_eval_cost;
|
||
break;
|
||
case LIMIT_ARRAY: result->max_array = def_array_size;
|
||
break;
|
||
case LIMIT_MAPPING_KEYS:
|
||
result->max_map_keys = def_mapping_keys;
|
||
break;
|
||
case LIMIT_MAPPING_SIZE:
|
||
result->max_mapping = def_mapping_size;
|
||
break;
|
||
case LIMIT_BYTE: result->max_byte = def_byte_xfer;
|
||
break;
|
||
case LIMIT_FILE: result->max_file = def_file_xfer;
|
||
break;
|
||
case LIMIT_CALLOUTS: result->max_callouts = def_callouts;
|
||
break;
|
||
default: errorf("Unimplemented limit #%d\n", limit);
|
||
}
|
||
}
|
||
else if (val != LIMIT_KEEP)
|
||
errorf("Illegal %s value: %"PRIdPINT"\n", limitnames[limit], val);
|
||
}
|
||
} /* set_single_limit() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static void
|
||
extract_limits ( struct limits_context_s * result
|
||
, svalue_t *svp
|
||
, int num
|
||
, Bool tagged
|
||
)
|
||
|
||
/* Extract the user-given runtime limits from <svp>...
|
||
* and store them into <result>. If <tagged> is FALSE, <svp> points to an array
|
||
* with the <num> values stored at the proper indices, otherwise <svp> points
|
||
* to a series of <num>/2 (tag, value) pairs.
|
||
*
|
||
* If the function encounters illegal limit tags or values, it throws
|
||
* an error.
|
||
*/
|
||
|
||
{
|
||
/* Set the defaults (unchanged) limits */
|
||
result->max_eval = max_eval_cost;
|
||
result->max_array = max_array_size;
|
||
result->max_mapping = max_mapping_size;
|
||
result->max_map_keys = max_mapping_keys;
|
||
result->max_callouts = max_callouts;
|
||
result->max_byte = max_byte_xfer;
|
||
result->max_file = max_file_xfer;
|
||
result->use_cost = 0;
|
||
|
||
if (!tagged)
|
||
{
|
||
int limit;
|
||
|
||
for (limit = 0; limit < LIMIT_MAX && limit < num; limit++)
|
||
{
|
||
set_single_limit(result, limit, svp+limit);
|
||
}
|
||
}
|
||
else
|
||
{
|
||
int i;
|
||
|
||
for (i = 0; i < num - 1; i += 2)
|
||
{
|
||
p_int limit;
|
||
|
||
if (svp[i].type != T_NUMBER)
|
||
errorf("Illegal limit value: got a %s, expected a number\n"
|
||
, typename(svp[i].type));
|
||
limit = svp[i].u.number;
|
||
if (limit < 0 || limit >= LIMIT_MAX)
|
||
errorf("Illegal limit tag: %"PRIdPINT"\n", limit);
|
||
|
||
set_single_limit(result, limit, svp+i+1);
|
||
}
|
||
}
|
||
} /* extract_limits() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
static vector_t *
|
||
create_limits_array (struct limits_context_s * rtlimits)
|
||
|
||
/* Create an array with the values from <rtlimits> and return it.
|
||
* Return NULL if out of memory.
|
||
*/
|
||
|
||
{
|
||
vector_t *vec;
|
||
|
||
vec = allocate_uninit_array(LIMIT_MAX);
|
||
if (vec)
|
||
{
|
||
put_number(vec->item+LIMIT_EVAL, rtlimits->max_eval);
|
||
put_number(vec->item+LIMIT_ARRAY, rtlimits->max_array);
|
||
put_number(vec->item+LIMIT_MAPPING_KEYS, rtlimits->max_map_keys);
|
||
put_number(vec->item+LIMIT_MAPPING_SIZE, rtlimits->max_mapping);
|
||
put_number(vec->item+LIMIT_BYTE, rtlimits->max_byte);
|
||
put_number(vec->item+LIMIT_FILE, rtlimits->max_file);
|
||
put_number(vec->item+LIMIT_CALLOUTS, rtlimits->max_callouts);
|
||
put_number(vec->item+LIMIT_COST, rtlimits->use_cost);
|
||
}
|
||
|
||
return vec;
|
||
} /* create_limits_array() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
v_limited (svalue_t * sp, int num_arg)
|
||
|
||
/* EFUN limited()
|
||
*
|
||
* mixed limited(closure fun)
|
||
* mixed limited(closure fun, int tag, int value, ...)
|
||
* mixed limited(closure fun, int * limits [, mixed args...] )
|
||
*
|
||
* Call the function <fun> and execute it with the given runtime limits.
|
||
* After the function exits, the currently active limits are restored.
|
||
* Result of the efun is the result of the closure call.
|
||
*
|
||
* The arguments can be given in two ways: as an array (like the one
|
||
* returned from query_limits(), or as a list of tagged values.
|
||
* If the efun is used without any limit specification, all limits
|
||
* are supposed to be 'unlimited'.
|
||
*
|
||
* The limit settings recognize three special values:
|
||
* LIMIT_UNLIMITED: the limit is deactivated
|
||
* LIMIT_KEEP: the former setting is kept
|
||
* LIMIT_DEFAULT: the 'global' default setting is used.
|
||
*
|
||
* The efun causes a privilege violation ("limited", current_object, closure).
|
||
*/
|
||
|
||
{
|
||
svalue_t *argp;
|
||
vector_t *vec;
|
||
struct limits_context_s limits;
|
||
int cl_args;
|
||
|
||
if (!num_arg)
|
||
errorf("No arguments given.\n");
|
||
|
||
argp = sp - num_arg + 1;
|
||
cl_args = 0;
|
||
|
||
/* Get the limits */
|
||
if (num_arg == 1)
|
||
{
|
||
limits.max_eval = 0;
|
||
limits.max_array = 0;
|
||
limits.max_mapping = 0;
|
||
limits.max_map_keys = 0;
|
||
limits.max_callouts = 0;
|
||
limits.max_byte = 0;
|
||
limits.max_file = 0;
|
||
limits.use_cost = 1; /* smallest we can do */
|
||
}
|
||
else if (argp[1].type == T_POINTER && VEC_SIZE(argp[1].u.vec) < INT_MAX)
|
||
{
|
||
extract_limits(&limits, argp[1].u.vec->item
|
||
, (int)VEC_SIZE(argp[1].u.vec)
|
||
, MY_FALSE);
|
||
cl_args = num_arg - 2;
|
||
}
|
||
else if (num_arg % 2 == 1)
|
||
{
|
||
extract_limits(&limits, argp+1, num_arg-1, MY_TRUE);
|
||
cl_args = 0;
|
||
}
|
||
else
|
||
{
|
||
errorf("limited(): Invalid limit specification.\n");
|
||
/* NOTREACHED */
|
||
return sp;
|
||
}
|
||
|
||
/* Create an array with the parsed limits to pass
|
||
* to privilege violation and store it in argp[1] so that
|
||
* it can be cleared in case of an error.
|
||
*/
|
||
if (num_arg > 1)
|
||
free_svalue(argp+1);
|
||
else
|
||
{
|
||
push_number(sp, 0);
|
||
num_arg++;
|
||
}
|
||
|
||
vec = create_limits_array(&limits);
|
||
if (!vec)
|
||
{
|
||
inter_sp = sp;
|
||
errorf("(set_limits) Out of memory: array[%d] for call.\n"
|
||
, LIMIT_MAX);
|
||
/* NOTREACHED */
|
||
return sp;
|
||
}
|
||
put_array(argp+1, vec);
|
||
|
||
/* If this object is destructed, no extern calls may be done */
|
||
if (current_object->flags & O_DESTRUCTED
|
||
|| !privilege_violation2(STR_LIMITED, argp, argp+1, sp)
|
||
)
|
||
{
|
||
sp = pop_n_elems(num_arg, sp);
|
||
sp++;
|
||
put_number(sp, 0);
|
||
}
|
||
else
|
||
{
|
||
struct limits_context_s context;
|
||
|
||
/* Save the current runtime limits and set the new ones */
|
||
save_limits_context(&context);
|
||
context.rt.last = rt_context;
|
||
rt_context = (rt_context_t *)&context.rt;
|
||
|
||
max_eval_cost = limits.max_eval ? limits.max_eval + eval_cost : 0;
|
||
/* Make sure that we get the requested amount of ticks, but remember
|
||
* that '0' means 'limitless'
|
||
*/
|
||
max_array_size = limits.max_array;
|
||
max_mapping_size = limits.max_mapping;
|
||
max_mapping_keys = limits.max_map_keys;
|
||
max_byte_xfer = limits.max_byte;
|
||
max_file_xfer = limits.max_file;
|
||
max_callouts = limits.max_callouts;
|
||
use_eval_cost = limits.use_cost;
|
||
|
||
assign_eval_cost();
|
||
inter_sp = sp;
|
||
call_lambda(argp, cl_args);
|
||
sp = inter_sp;
|
||
|
||
/* Overwrite the closure with the result */
|
||
free_svalue(argp); /* The closure might have self-destructed */
|
||
*argp = *sp;
|
||
sp--;
|
||
|
||
/* Free the remaining arguments from the efun call */
|
||
sp = pop_n_elems(num_arg - cl_args - 1, sp);
|
||
|
||
/* Restore the old limits */
|
||
max_eval_cost = limits.max_eval;
|
||
/* the +eval_cost above was good for proper execution,
|
||
* but might mislead the eval_cost evaluation in the
|
||
* restore().
|
||
*/
|
||
rt_context = context.rt.last;
|
||
restore_limits_context(&context);
|
||
}
|
||
|
||
/* Stack is clean and sp points to the result */
|
||
return sp;
|
||
} /* v_limited() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
v_set_limits (svalue_t * sp, int num_arg)
|
||
|
||
/* EFUN set_limits()
|
||
*
|
||
* void set_limits(int tag, int value, ...)
|
||
* void set_limits(int * limits)
|
||
*
|
||
* Set the default runtime limits from the given arguments. The new limits
|
||
* will be in effect for the next execution thread.
|
||
*
|
||
* The arguments can be given in two ways: as an array (like the one
|
||
* returned from query_limits(), or as a list of tagged values.
|
||
* The limit settings recognize three special values:
|
||
* LIMIT_UNLIMITED: the limit is deactivated
|
||
* LIMIT_DEFAULT: the global setting is used.
|
||
* LIMIT_KEEP: the former setting is kept
|
||
*
|
||
* The efun causes a privilege violation ("set_limits", current_object, first
|
||
* arg).
|
||
*/
|
||
|
||
{
|
||
svalue_t *argp;
|
||
struct limits_context_s limits;
|
||
vector_t *vec;
|
||
|
||
if (!num_arg)
|
||
errorf("No arguments given.\n");
|
||
|
||
argp = sp - num_arg + 1;
|
||
|
||
if (num_arg == 1 && argp->type == T_POINTER && VEC_SIZE(argp->u.vec) < INT_MAX)
|
||
extract_limits(&limits, argp->u.vec->item, (int)VEC_SIZE(argp->u.vec)
|
||
, MY_FALSE);
|
||
else if (num_arg % 2 == 0)
|
||
extract_limits(&limits, argp, num_arg, MY_TRUE);
|
||
else
|
||
{
|
||
errorf("set_limits(): Invalid limit specification.\n");
|
||
/* NOTREACHED */
|
||
return sp;
|
||
}
|
||
|
||
/* On the stack, create an array with the parsed limits to pass
|
||
* to privilege violation.
|
||
*/
|
||
sp = pop_n_elems(num_arg, sp); /* sp == argp now */
|
||
vec = create_limits_array(&limits);
|
||
if (!vec)
|
||
{
|
||
inter_sp = sp;
|
||
errorf("(set_limits) Out of memory: array[%d] for call.\n"
|
||
, LIMIT_MAX);
|
||
/* NOTREACHED */
|
||
return sp;
|
||
}
|
||
push_array(sp, vec);
|
||
num_arg = 1;
|
||
|
||
if (privilege_violation(STR_SET_LIMITS, argp, sp))
|
||
{
|
||
/* Now store the parsed limits into the variables */
|
||
def_eval_cost = limits.max_eval;
|
||
def_array_size = limits.max_array;
|
||
def_mapping_size = limits.max_mapping;
|
||
def_mapping_keys = limits.max_map_keys;
|
||
def_byte_xfer = limits.max_byte;
|
||
def_file_xfer = limits.max_file;
|
||
def_callouts = limits.max_callouts;
|
||
}
|
||
|
||
sp = pop_n_elems(num_arg, sp);
|
||
return sp;
|
||
} /* v_set_limits() */
|
||
|
||
/*-------------------------------------------------------------------------*/
|
||
svalue_t *
|
||
f_query_limits (svalue_t * sp)
|
||
|
||
/* EFUN query_limits()
|
||
*
|
||
* int * query_limits(int defaults)
|
||
*
|
||
* Return an array with the current runtime limits, resp. if defaults
|
||
* is true, the default runtime limits. The entries in the returned
|
||
* array are:
|
||
*
|
||
* int[LIMIT_EVAL]: the max number of eval costs
|
||
* int[LIMIT_ARRAY]: the max number of array entries
|
||
* int[LIMIT_MAPPING_SIZE]: the max number of mapping values
|
||
* int[LIMIT_MAPPING_KEYS]: the max number of mapping entries
|
||
* (LIMIT_MAPPING is an alias for LIMIT_MAPPING_KEYS)
|
||
* int[LIMIT_BYTE]: the max number of bytes for one read/write_bytes()
|
||
* int[LIMIT_FILE]: the max number of bytes for one read/write_file()
|
||
* int[LIMIT_COST]: how to account for the evaluation cost
|
||
*
|
||
* A limit of '0' means 'no limit', except for LIMIT_COST.
|
||
*/
|
||
|
||
{
|
||
vector_t *vec;
|
||
Bool def;
|
||
|
||
def = sp->u.number != 0;
|
||
|
||
vec = allocate_uninit_array(LIMIT_MAX);
|
||
if (!vec)
|
||
{
|
||
errorf("(query_limits) Out of memory: array[%d] for result.\n"
|
||
, LIMIT_MAX);
|
||
/* NOTREACHED */
|
||
return sp;
|
||
}
|
||
|
||
put_number(vec->item+LIMIT_EVAL, def ? def_eval_cost : max_eval_cost);
|
||
put_number(vec->item+LIMIT_ARRAY, def ? def_array_size : max_array_size);
|
||
put_number(vec->item+LIMIT_MAPPING_KEYS
|
||
, def ? def_mapping_keys : max_mapping_keys);
|
||
put_number(vec->item+LIMIT_MAPPING_SIZE
|
||
, def ? def_mapping_size : max_mapping_size);
|
||
put_number(vec->item+LIMIT_BYTE, def ? def_byte_xfer : max_byte_xfer);
|
||
put_number(vec->item+LIMIT_FILE, def ? def_file_xfer : max_file_xfer);
|
||
put_number(vec->item+LIMIT_CALLOUTS, def ? def_callouts : max_callouts);
|
||
put_number(vec->item+LIMIT_COST, def ? DEF_USE_EVAL_COST : use_eval_cost);
|
||
|
||
/* No free_svalue: sp is a number */
|
||
put_array(sp, vec);
|
||
return sp;
|
||
} /* f_query_limits() */
|
||
|
||
/***************************************************************************/
|
||
|