/*--------------------------------------------------------------------------- * 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 #include #include #include #include #include #include /*-------------------------------------------------------------------------*/ #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 */ #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 . */ 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 (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 . * * 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 , 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) : ""); #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) : ""); 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 * every '%s' spec is changed to '%.200s' to avoid buffer overflows. * The modified format string is stored in (a caller provided * buffer of size ) 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 string was complete: mark this error message * as truncated. * ffptr points to the last byte in the 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 * 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(, ,...) function which translates the * TODO:: errno into a string and calls errorf(, ...). */ { 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 * 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(, ,...) function which translates the * TODO:: errno into a string and calls errorf(, ...). */ { 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 ( is FALSE) resp. * a warning ( is TRUE) while compiling of * file . The context of the error location is . * * 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 in the * error context and then do the proper longjmp. 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 to object , 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. * 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 will be given its uids. Push an error handler onto the * interpreter stack which will clean up 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 was just created - call the driver_hook with * arguments to give it its uid and euid. * Return TRUE on success - on failure, destruct 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 '#'). * * 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 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 . If is not NULL, * ": ''" is appended to the message. If is not NULL, * " (inherited by )" 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 . * is true if the object has to be * initialized with CREATE_SUPER, and false if CREATE_OB is to be used. * is the current recursive load depth and is checked * against MAX_LOAD_DEPTH. * is TRUE if the top-level object to be compiled is the master * object. * 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 must be sane object name, and can be a clone name. * * If there is no source file .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 */ char *fname; /* Filename for */ 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 : 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 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 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) : "" , 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) /* is a basic object name - generate a clone name "#" * 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 , 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) : "" , 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 , optionally loading it ( is true). * Return a pointer to the object structure, or NULL. * * If is true, the function tries to load the object if it is * not already loaded. * If 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 . * 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 . * 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 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 . 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 . 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) : "" ); #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 is FALSE, the call immediately returns if the flag * (in object.c) is FALSE - this flag is set by * free_object() if all but one reference to a destructed object is gone. * If 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

. */ { #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 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 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 and if recognized, dump the * data into the stringbuffer . * * 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 . * If is -1, points indeed to a value block; other it is * the index of the desired value and 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 will read resp. write () the file * for the efun . * * 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 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 * 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 . */ { 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 . * 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 to hold the * arguments starting from . If 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 to hold a function * call to : with the arguments starting from . * If 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 and 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 to hold a closure * call to with the arguments starting from . * If 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 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 with the * values starting at . 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 . */ { 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 . * 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 with the 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 is TRUE, the callback structure will not be freed. * If 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 of length matches the pattern . * 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 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(""); } 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(""); else if (arg->type == T_MAPPING) add_message(""); else if (arg->type == T_CLOSURE) add_message(""); else add_message("", 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 , or alternatively from * the object