示例#1
0
static void PSIG(sig_usr1)
{
    push_string("Host machine shutting down", STRING_CONSTANT);
    push_undefined();
    push_undefined();
    apply_master_ob(APPLY_CRASH, 3);
    debug_message("Received SIGUSR1, calling exit(-1)\n");
    exit(-1);
}
示例#2
0
/*! @decl string _sprintf()
 */
static void f_path_element_sprintf(INT32 args)
{
  INT_TYPE mode;
  struct mapping *opts;
  cairo_path_data_t* data = THIS->element;

  get_all_args("_sprintf", args, "%i%m", &mode, &opts);
  pop_n_elems (args);
  if (mode == 'O')
    {
      switch (data->header.type)
        {
        case CAIRO_PATH_MOVE_TO:
          push_constant_text ("%O(CAIRO_PATH_MOVE_TO(%f,%f))");
          ref_push_object(Pike_fp->current_object);
          f_object_program (1);
          push_float(data[1].point.x); push_float(data[1].point.y);
          f_sprintf(4);
          break;
        case CAIRO_PATH_LINE_TO:
          push_constant_text ("%O(CAIRO_PATH_LINE_TO(%f,%f))");
          ref_push_object(Pike_fp->current_object);
          f_object_program (1);
          push_float(data[1].point.x); push_float(data[1].point.y);
          f_sprintf(4);
          break;
        case CAIRO_PATH_CURVE_TO:
          push_constant_text ("%O(CAIRO_PATH_CURVE_TO(%f,%f,%f,%f,%f))");
          ref_push_object(Pike_fp->current_object);
          f_object_program (1);
          push_float(data[1].point.x); push_float(data[1].point.y);
          push_float(data[2].point.x); push_float(data[2].point.y);
          push_float(data[3].point.x); push_float(data[3].point.y);
          f_sprintf(8);
          break;
        case CAIRO_PATH_CLOSE_PATH:
          push_constant_text ("%O(CAIRO_PATH_CLOSE_PATH()");
          ref_push_object(Pike_fp->current_object);
          f_object_program (1);
          f_sprintf(2);
          break;
        default:
          push_undefined();
          return;
        }
    }
  else
    push_undefined();
}
示例#3
0
文件: database.c 项目: ViKingIX/NtOS
void f_query_temp () {
    int idx;
    object_t *ob;
    unsigned short type;
    svalue_t *value;
    char *src, *dst;
    mapping_t *map;
    char *tmpstr;

    if( st_num_arg==2 ) {
        ob=sp->u.ob;
        pop_stack();
    } else
        ob = current_object;

    idx = find_global_variable(ob->prog, "tmp_dbase", &type, 0);
    if (idx == -1)
    {
        free_string_svalue(sp--);
        push_undefined();
        return;
    }
    value = &ob->variables[idx];

    if( value->type != T_MAPPING )
    {
    	free_string_svalue(sp--);
    	error("(query_temp) %s 物件的资料库变数型态错误。\n", ob->obname);
    }

    map = value->u.map;
    src = (char *)sp->u.string;
    dst = tmpstr = (char *)DMALLOC(SVALUE_STRLEN(sp) + 1, TAG_STRING, "query_temp");

    while (*src)
    {
	while (*src != '/' && *src)
	    *dst++ = *src++;
	if (*src == '/')
	{
	    while (*++src == '/');
	    if( dst == tmpstr ) continue;
	}
	*dst = '\0';
	value = find_string_in_mapping(map, tmpstr);

	if( value == &const0u ) break;
	if( value->type != T_MAPPING )
	{
	    if(*src) value = &const0u;
	    break;
	}
	map = value->u.map;
	dst = tmpstr;
    }

    FREE(tmpstr);
    free_string_svalue(sp--);
    push_svalue(value);
}
示例#4
0
void f_compress (void)
{
   unsigned char* buffer;
   unsigned char* input;
   int size;
   buffer_t* real_buffer;
   uLongf new_size;

   if (sp->type == T_STRING) {
      size = SVALUE_STRLEN(sp);
      input = (unsigned char*)sp->u.string;
   } else if (sp->type == T_BUFFER) {
      size = sp->u.buf->size;
      input = sp->u.buf->item;
   } else {
      pop_n_elems(st_num_arg);
      push_undefined();
      return ;
   }

   new_size = size;
   // Make it a little larger as specified in the docs.
   buffer = (unsigned char*)DXALLOC(size * 101 / 100 + 12, TAG_TEMPORARY, "compress");
   compress(buffer, &new_size, input, size);

   // Shrink it down.
   pop_n_elems(st_num_arg);
   real_buffer = allocate_buffer(new_size);
   write_buffer(real_buffer, 0, (char *)buffer, new_size);
   FREE(buffer);
   push_buffer(real_buffer);
}
示例#5
0
文件: dwlib.c 项目: Yuffster/fluffOS
void
f_reference_allowed()
  {
    svalue_t *sv = sp - st_num_arg + 1;
    svalue_t *v;
    object_t *referee = NULL;
    object_t *referrer_obj = command_giver; /* Default to this_player(). */
    const char *referrer_name = NULL;
    int result = 0;
    int num_arg = st_num_arg;

    /* Maybe I could learn how to use this :p 
    CHECK_TYPES(sp-1, T_NUMBER, 1, F_MEMBER_ARRAY); */

    if (sv->type == T_OBJECT && sv->u.ob) {
        referee = sv->u.ob;
    }

    if (st_num_arg > 1) {
        if (sv[1].type == T_STRING && sv[1].u.string) {
            /* We've been passed in a string, now we need to call 
             * find_player() */ 
#ifdef F_FIND_PLAYER
            /* If we have a find_player() efun, then we need to sue 
             * the following method.  This hasn't been tested!
             */ 
             referrer = find_living_object(sv[1].u.string, 1);
#else
            if (simul_efun_ob) {
                push_svalue(&sv[1]);
                v = apply("find_player", simul_efun_ob, 1, ORIGIN_EFUN);

                if (v && v->type == T_OBJECT) {
                    referrer_obj = v->u.ob;
                    referrer_name = sv[1].u.string;
                }
                else {
                    referrer_obj = NULL;
                    referrer_name = sv[1].u.string;
                }
            }
#endif
        }
        if (sv[1].type == T_OBJECT && sv[1].u.ob) { 
            referrer_obj = sv[1].u.ob;
            referrer_name = NULL;
        }
    }

    if (referee && (referrer_obj || referrer_name)) {
        result = reference_allowed(referee, referrer_obj, referrer_name);

        pop_n_elems(num_arg);
        push_number(result);
    } else { 
        pop_n_elems(num_arg);
        push_undefined();
    }
}
示例#6
0
文件: async.c 项目: Elohim/FGmud
void handle_write(struct request *req){
	free_svalue(&req->tmp, "handle_write");
	int val = req->ret;
	if(val < 0){
		push_number(val);
		set_eval(max_cost);
		safe_call_efun_callback(req->fun, 1);
		return;
	}
	push_undefined();
	set_eval(max_cost);
	safe_call_efun_callback(req->fun, 1);
}
示例#7
0
/*! @decl mapping(string:float) get_point(int point)
 */
static void f_path_element_get_point(INT32 args)
{
  int i;
  get_all_args("get_point", args, "%d", &i);
  i++; // index includes header
  if (i > 0 && i < THIS->element->header.length)
    {
      push_text( "x" );
      push_float(THIS->element[i].point.x);
      push_text( "y" );
      push_float(THIS->element[i].point.y);
      f_aggregate_mapping(4);
    }
  else
    push_undefined();
}
示例#8
0
void handle_write(struct request *req, int val){
    aiob *aio = req->aio;
    close(aio->aio_fildes);
    free_svalue(&req->tmp, "handle_write");
    if(val){
        push_number(val);
        set_eval(max_cost);
        safe_call_efun_callback(req->fun, 1);
        return;
    }
    val = aio_return(aio);
    if(val < 0){
        push_number(val);
        set_eval(max_cost);
        safe_call_efun_callback(req->fun, 1);
        return;
    }
    push_undefined();
    set_eval(max_cost);
    safe_call_efun_callback(req->fun, 1);
}
示例#9
0
文件: yp.c 项目: pikelang/Pike
/*! @decl string match(string map, string key)
 *!
 *! Search for the key @[key] in the Yp-map @[map].
 *!
 *! @returns
 *! If there is no @[key] in the map, 0 (zero) will be returned,
 *! otherwise the string matching the key will be returned.
 *!
 *! @note
 *! @[key] must match exactly, no pattern matching of any kind is done.
 */
static void f_match(INT32 args)
{
  int err;
  char *retval;
  int retlen;

  check_all_args(NULL, args, BIT_STRING, BIT_STRING, 0);

  err = yp_match( this->domain, sp[-args].u.string->str,
		  sp[-args+1].u.string->str, sp[-args+1].u.string->len,
		  &retval, &retlen );

  if(err == YPERR_KEY)
  {
    pop_n_elems( args );
    push_undefined();
    return;
  }

  YPERROR( err );

  pop_n_elems( args );
  push_string(make_shared_binary_string( retval, retlen ));
}
示例#10
0
文件: dwlib.c 项目: Yuffster/fluffOS
/* Hideous mangling of C code by Taffyd. */ 
void query_multiple_short(svalue_t * arg, const char * type, int no_dollars, int quiet, int dark, int num_arg) { 
    char m[] = "$M$";
    char s[] = "_short";
    char default_function[] = "a_short";
    char separator[] = ", ";
    char andsep[] = " and ";
    int mlen = strlen(m);
    int slen = strlen(s);
    int seplen = strlen( separator );
    int andlen = strlen( andsep );

    array_t *arr = arg->u.arr;
    svalue_t *sv;
    svalue_t *v;
    int size = arr->size;
    int i;
    int len;
    int total_len;
    char *str, *res;
    object_t *ob;
    char *fun; 

    if (!size) {
        str = new_string(0, "f_query_multiple_short");
        str[0] = '\0';
        pop_n_elems(num_arg);
        push_malloced_string(str);
        return; 
    }
    
    /* 
    if (no_dollars && sizeof(args) && objectp(args[0]) && undefinedp(dark) && 
        this_player() && environment(this_player())) {
        dark = this_player()->check_dark(environment(this_player())->query_light());
        if (dark) {
        return "some objects you cannot make out";
        }
    } */ 

    if (no_dollars && arr->item->type == T_OBJECT && !dark && command_giver &&
        command_giver->super) { 
        call_origin = ORIGIN_EFUN;
        if(!apply_low("query_light", command_giver->super, 0))
            push_number(0);
        v = apply("check_dark", command_giver, 1, ORIGIN_EFUN);
        
        if (v && v->type == T_NUMBER && v->u.number) {
            pop_n_elems(num_arg);
            copy_and_push_string("some objects you cannot make out"); 
            return;
        }
    }

    /* If we don't have a type parameter, then use default_function */ 
    /* We need to free this value with FREE_MSTR() */ 

    if ( !type ) { 
        len = strlen( default_function );
        fun = new_string( len, "f_query_multiple_short");
        fun[len] = '\0';
        strncpy( fun, default_function, len );
    }
    else { 
        len = strlen( type ) + slen;
        fun = new_string( len, "f_query_multiple_short");
        fun[len] = '\0';
        strncpy( fun, type, len );
        strncpy( fun + strlen( type ), s, slen);
    }
   
    /* Check to see if there are any non-objects in the array. */ 
    for (i = 0; i < size; i++) {
        if ((arr->item + i)->type != T_OBJECT) {
            break;
        }
    }

    /* The array consists only of objects, and will use the $M$ 
       expansion code. */ 
    if (i == size && !no_dollars) {
        str = new_string(max_string_length, "f_query_multiple_short");
        str[max_string_length]= '\0';
        strncpy(str, m, mlen);
        total_len = mlen;

        for ( i = 0; i < size; i++ ) {
            sv = (arr->item + i);
            push_number(quiet);
            v = apply(fun, sv->u.ob, 1, ORIGIN_EFUN);

            if (!v || v->type != T_STRING) {
                continue;                
            }
            if(total_len + SVALUE_STRLEN(v) > max_string_length - mlen)
                continue;
            strncpy(str + total_len, v->u.string, (len = SVALUE_STRLEN(v)));
            total_len += len;
        }

        strncpy(str + total_len, m, mlen);
        total_len += mlen;

        res = new_string( total_len, "f_query_multiple_short" );
        res[ total_len ] = '\0';
        memcpy(res, str, total_len);

        /* Clean up our temporary buffer. */ 

        FREE_MSTR(str);
        FREE_MSTR(fun);

        pop_n_elems(num_arg);
        push_malloced_string(res);
        return;
    }

    /* This is a mixed array, so we don't use $M$ format.  Instead, we 
       do as much $a_short$ conversion as we can etc.  */ 

    str = new_string(max_string_length, "f_query_multiple_short");
    str[max_string_length]= '\0';
    total_len = 0;

    for ( i = 0; i < size; i++ ) {
        sv = (arr->item + i);
    
        switch(sv->type) {
            case T_STRING:
                len = SVALUE_STRLEN(sv);
                if(total_len + len < max_string_length){
                    strncpy(str + total_len, sv->u.string, len);
                    total_len += len;
                }
                break;
            case T_OBJECT:
                push_number(quiet);
                v = apply(fun, sv->u.ob, 1, ORIGIN_EFUN);

                if (!v || v->type != T_STRING) {
                    continue;                
                }

                if(total_len + SVALUE_STRLEN(v) < max_string_length){
                    strncpy(str + total_len, v->u.string, 
                            (len = SVALUE_STRLEN(v)));
                    total_len += len;
                }

                break;
            case T_ARRAY:
              /* Does anyone use this? */ 
              /* args[ i ] = "$"+ type +"_short:"+ file_name( args[ i ][ 1 ] ) +"$"; */ 
            default:    
                /* Get the next element. */ 
                continue;            
                break;
        }
        
        if ( len && size > 1 ) {
            if ( i < size - 2 ) {
                if(total_len+seplen < max_string_length){
                    strncpy( str + total_len, separator, seplen );
                    total_len += seplen;
                }
            }
            else { 
                if ( i < size - 1 ) {    
                    if(total_len+andlen < max_string_length){
                        strncpy( str + total_len, andsep, andlen );
                        total_len += andlen;
                    }
                }
            }
        }
    }

    FREE_MSTR(fun);

    res = new_string(total_len, "f_query_multiple_short");
    res[total_len] = '\0';
    memcpy(res, str, total_len);

    FREE_MSTR(str);

    /* Ok, now that we have cleaned up here we have to decide what to do
       with it. If nodollars is 0, then we need to pass it to an object
       for conversion. */ 

    if (no_dollars) { 
        if (command_giver) { 
            /* We need to call on this_player(). */ 
            push_malloced_string(res);
            v = apply("convert_message", command_giver, 1, ORIGIN_EFUN);
            
            if (v && v->type == T_STRING) { 
                pop_n_elems(num_arg);
                share_and_push_string(v->u.string);
            }
            else { 
                pop_n_elems(num_arg);
                push_undefined();
            }
            
        }
        else {
            /* We need to find /global/player. */ 
            /* Does this work? Seems not to. */ 
            ob = find_object("/global/player");
            
            if (ob) {
                push_malloced_string(res);
                v = apply("convert_message", ob, 1, ORIGIN_EFUN);
                
                /* Return the result! */ 
                if (v && v->type == T_STRING) { 
                    pop_n_elems(num_arg);
                    share_and_push_string(v->u.string);
                }
                else { 
                    pop_n_elems(num_arg);
                    push_undefined();
                }
            }
            else { 
                pop_n_elems(num_arg);
                push_undefined();
            }
        }

    }
    else { 
        pop_n_elems(num_arg);
        push_malloced_string(res);
    }
} /* query_multiple_short() */
示例#11
0
文件: add_action.c 项目: Elohim/FGmud
static int user_parser (char * buff)
{
    char verb_buff[MAX_VERB_BUFF];
    sentence_t *s;
    char *p;
    int length;
    char *user_verb = 0;
    int where;
    int save_illegal_sentence_action;

    debug(d_flag, ("cmd [/%s]: %s\n", command_giver->obname, buff));

    /* strip trailing spaces. */
    for (p = buff + strlen(buff) - 1; p >= buff; p--) {
	if (*p != ' ')
	    break;
	*p = '\0';
    }
    if (buff[0] == '\0')
	return 0;
    length = p - buff + 1;
    p = strchr(buff, ' ');
    if (p == 0) {
	user_verb = findstring(buff);
    } else {
	*p = '\0';
	user_verb = findstring(buff);
	*p = ' ';
	length = p - buff;
    }
    if (!user_verb) {
	/* either an xverb or a verb without a specific add_action */
	user_verb = buff;
    }
    /*
     * copy user_verb into a static character buffer to be pointed to by
     * last_verb.
     */
    strncpy(verb_buff, user_verb, MAX_VERB_BUFF - 1);
    if (p) {
	int pos;

	pos = p - buff;
	if (pos < MAX_VERB_BUFF) {
	    verb_buff[pos] = '\0';
	}
    }

    save_illegal_sentence_action = illegal_sentence_action;
    illegal_sentence_action = 0;
    for (s = command_giver->sent; s; s = s->next) {
	svalue_t *ret;
	object_t *command_object;

	if (s->flags & (V_NOSPACE | V_SHORT)) {
	    if (strncmp(buff, s->verb, strlen(s->verb)) != 0)
		continue;
	} else {
	    /* note: if was add_action(blah, "") then accept it */
	    if (s->verb[0] && (user_verb != s->verb))
		continue;
	}
	/*
	 * Now we have found a special sentence !
	 */

	if (!(s->flags & V_FUNCTION))
	    debug(d_flag, ("Local command %s on /%s",
			   s->function.s, s->ob->obname));

	if (s->flags & V_NOSPACE) {
	    int l1 = strlen(s->verb);
	    int l2 = strlen(verb_buff);

	    if (l1 < l2)
		last_verb = verb_buff + l1;
	    else
		last_verb = "";
	} else {
	    if (!s->verb[0] || (s->flags & V_SHORT))
		last_verb = verb_buff;
	    else
		last_verb = s->verb;
	}
	/*
	 * If the function is static and not defined by current object, then
	 * it will fail. If this is called directly from user input, then
	 * the origin is the driver and it will be allowed.
	 */
	where = (current_object ? ORIGIN_EFUN : ORIGIN_DRIVER);

	/*
	 * Remember the object, to update moves.
	 */
	command_object = s->ob;
	save_command_giver(command_giver);
	if (s->flags & V_NOSPACE) {
	    copy_and_push_string(&buff[strlen(s->verb)]);
	} else if (buff[length] == ' ') {
	    copy_and_push_string(&buff[length + 1]);
	} else {
	    push_undefined();
	}
	if (s->flags & V_FUNCTION) {
	    ret = call_function_pointer(s->function.f, 1);
	} else {
	    if (s->function.s[0] == APPLY___INIT_SPECIAL_CHAR)
		error("Illegal function name.\n");
	    ret = apply(s->function.s, s->ob, 1, where);
	}
	/* s may be dangling at this point */

	restore_command_giver();

	last_verb = 0;

	/* was this the right verb? */
	if (ret == 0) {
	    /* is it still around?  Otherwise, ignore this ...
	       it moved somewhere or dested itself */
	    if (s == command_giver->sent) {
		char buf[256];
		if (s->flags & V_FUNCTION) {
		    sprintf(buf, "Verb '%s' bound to uncallable function pointer.\n", s->verb);
		    error(buf);
		} else {
		    sprintf(buf, "Function for verb '%s' not found.\n",
			    s->verb);
		    error(buf);
		}
	    }
	}

	if (ret && (ret->type != T_NUMBER || ret->u.number != 0)) {
#ifdef PACKAGE_MUDLIB_STATS
	    if (command_giver && command_giver->interactive
#ifndef NO_WIZARDS
		&& !(command_giver->flags & O_IS_WIZARD)
#endif
		)
		add_moves(&command_object->stats, 1);
#endif
	    if (!illegal_sentence_action)
		illegal_sentence_action = save_illegal_sentence_action;
	    return 1;
	}
	if (illegal_sentence_action) {
	    switch (illegal_sentence_action) {
	    case 1:
		error("Illegal to call remove_action() [caller was /%s] from a verb returning zero.\n", illegal_sentence_ob->obname);
	    case 2:
		error("Illegal to move or destruct an object (/%s) defining actions from a verb function which returns zero.\n", illegal_sentence_ob->obname);
	    }
	}
    }
    notify_no_command();
    illegal_sentence_action = save_illegal_sentence_action;

    return 0;
}
示例#12
0
void f_uncompress (void)
{
   z_stream* compressed;
   unsigned char compress_buf[COMPRESS_BUF_SIZE];
   unsigned char* output_data = NULL;
   int len;
   int pos;
   buffer_t* buffer;
   int ret;

   if (sp->type == T_BUFFER) {
      buffer = sp->u.buf;
   } else {
      pop_n_elems(st_num_arg);
      push_undefined();
      return ;
   }

   compressed = (z_stream *)
            DXALLOC(sizeof(z_stream), TAG_INTERACTIVE,
                    "start_compression");
   compressed->next_in = buffer->item;
   compressed->avail_in = buffer->size;
   compressed->next_out = compress_buf;
   compressed->avail_out = COMPRESS_BUF_SIZE;
   compressed->zalloc = zlib_alloc;
   compressed->zfree = zlib_free;
   compressed->opaque = NULL;

   if (inflateInit(compressed) != Z_OK) {
      FREE(compressed);
      pop_n_elems(st_num_arg);
      push_undefined();
      return ;
   }

   len = 0;
   output_data = NULL;
   do {
      ret = inflate(compressed, 0);
      if (ret == Z_OK) {
         pos = len;
         len += COMPRESS_BUF_SIZE - compressed->avail_out;
         if (!output_data) {
            output_data = (unsigned char*)DXALLOC(len, TAG_TEMPORARY, "uncompress");
         } else {
            output_data = REALLOC(output_data, len);
         }
         memcpy(output_data + pos, compress_buf, len - pos);
         compressed->next_out = compress_buf;
         compressed->avail_out = COMPRESS_BUF_SIZE;
      }
   } while (ret == Z_OK);

   inflateEnd(compressed);

   pop_n_elems(st_num_arg);

   if (ret == Z_STREAM_END) {
      buffer = allocate_buffer(len);
      memcpy(buffer->item, output_data, len);
      FREE(output_data);
      push_buffer(buffer);
   } else {
      push_undefined();
   }
}
示例#13
0
/*! @decl program load_module(string module_name)
 *!
 *! Load a binary module.
 *!
 *! This function loads a module written in C or some other language
 *! into Pike. The module is initialized and any programs or constants
 *! defined will immediately be available.
 *!
 *! When a module is loaded the C function @tt{pike_module_init()@} will
 *! be called to initialize it. When Pike exits @tt{pike_module_exit()@}
 *! will be called. These two functions @b{must@} be available in the module.
 *!
 *! @note
 *!   The current working directory is normally not searched for
 *!   dynamic modules. Please use @expr{"./name.so"@} instead of just
 *!   @expr{"name.so"@} to load modules from the current directory.
 */
void f_load_module(INT32 args)
{
  extern int global_callable_flags;

  void *module;
  modfun init, exit;
  struct module_list *new_module;
  struct pike_string *module_name;

  ONERROR err;

  module_name = Pike_sp[-args].u.string;

  if((Pike_sp[-args].type != T_STRING) ||
     (module_name->size_shift) ||
     string_has_null(module_name)) {
    Pike_error("Bad argument 1 to load_module()\n");
  }

  {
    struct module_list *mp;
    for (mp = dynamic_module_list; mp; mp = mp->next)
      if (mp->name == module_name && mp->module_prog) {
	pop_n_elems(args);
	ref_push_program(mp->module_prog);
	return;
      }
  }

  /* Removing RTLD_GLOBAL breaks some PiGTK themes - Hubbe */
  /* Using RTLD_LAZY is faster, but makes it impossible to 
   * detect linking problems at runtime..
   */
  module=dlopen(module_name->str, 
                RTLD_NOW /*|RTLD_GLOBAL*/  );

  if(!module)
  {
    struct object *err_obj = low_clone (module_load_error_program);
#define LOADERR_STRUCT(OBJ) \
    ((struct module_load_error_struct *) (err_obj->storage + module_load_error_offset))

    const char *err = dlerror();
    if (err) {
      if (err[strlen (err) - 1] == '\n')
	push_string (make_shared_binary_string (err, strlen (err) - 1));
      else
	push_text (err);
    }
    else
      push_constant_text ("Unknown reason");

    add_ref (LOADERR_STRUCT (err_obj)->path = Pike_sp[-args - 1].u.string);
    add_ref (LOADERR_STRUCT (err_obj)->reason = Pike_sp[-1].u.string);

    if (Pike_sp[-args].u.string->len < 1024) {
      throw_error_object (err_obj, "load_module", Pike_sp - args - 1, args,
			  "load_module(\"%s\") failed: %s\n",
			  module_name->str, Pike_sp[-1].u.string->str);
    } else {
      throw_error_object (err_obj, "load_module", Pike_sp - args - 1, args,
			  "load_module() failed: %s\n",
			  Pike_sp[-1].u.string->str);
    }
  }

#ifdef PIKE_DEBUG
  {
    struct module_list *mp;
    for (mp = dynamic_module_list; mp; mp = mp->next)
      if (mp->module == module && mp->module_prog) {
	fprintf(stderr, "load_module(): Module loaded twice:\n"
		"Old name: %s\n"
		"New name: %s\n",
		mp->name->str, module_name->str);
	pop_n_elems(args);
	ref_push_program(mp->module_prog);
	return;
      }
  }
#endif /* PIKE_DEBUG */

  init = CAST_TO_FUN(dlsym(module, "pike_module_init"));
  if (!init) {
    init = CAST_TO_FUN(dlsym(module, "_pike_module_init"));
    if (!init) {
      dlclose(module);
      Pike_error("pike_module_init missing in dynamic module \"%S\".\n",
		 module_name);
    }
  }

  exit = CAST_TO_FUN(dlsym(module, "pike_module_exit"));
  if (!exit) {
    exit = CAST_TO_FUN(dlsym(module, "_pike_module_exit"));
    if (!exit) {
      dlclose(module);
      Pike_error("pike_module_exit missing in dynamic module \"%S\".\n",
		 module_name);
    }
  }

#if defined(__NT__) && defined(_M_IA64)
  {
    fprintf(stderr, "pike_module_init: 0x%p\n"
	    "  func: 0x%p\n"
	    "  gp:   0x%p\n",
	    init, ((void **)init)[0], ((void **)init)[1]);
    fprintf(stderr, "pike_module_exit: 0x%p\n"
	    "  func: 0x%p\n"
	    "  gp:   0x%p\n",
	    exit, ((void **)exit)[0], ((void **)exit)[1]);
  }
#endif /* __NT__ && _M_IA64 */

  new_module=ALLOC_STRUCT(module_list);
  new_module->next=dynamic_module_list;
  dynamic_module_list=new_module;
  new_module->module=module;
  copy_shared_string(new_module->name, Pike_sp[-args].u.string);
  new_module->module_prog = NULL;
  new_module->init=init;
  new_module->exit=exit;

  enter_compiler(new_module->name, 1);

  start_new_program();

  global_callable_flags|=CALLABLE_DYNAMIC;

#ifdef PIKE_DEBUG
  { struct svalue *save_sp=Pike_sp;
#endif
  SET_ONERROR(err, cleanup_compilation, NULL);
#if defined(__NT__) && defined(_M_IA64)
  fprintf(stderr, "Calling pike_module_init()...\n");
#endif /* __NT__ && _M_IA64 */
  (*(modfun)init)();
#if defined(__NT__) && defined(_M_IA64)
  fprintf(stderr, "pike_module_init() done.\n");
#endif /* __NT__ && _M_IA64 */
  UNSET_ONERROR(err);
#ifdef PIKE_DEBUG
  if(Pike_sp != save_sp)
    Pike_fatal("load_module(%s) left %ld droppings on stack!\n",
	       module_name->str,
	       PTRDIFF_T_TO_LONG(Pike_sp - save_sp));
  }
#endif

  pop_n_elems(args);
  {
    struct program *p = end_program();
    exit_compiler();
    if (p) {
      if (
#if 0
	  p->num_identifier_references
#else /* !0 */
	  1
#endif /* 0 */
	  ) {
	push_program(p);
	add_ref(new_module->module_prog = Pike_sp[-1].u.program);
      } else {
	/* No identifier references -- Disabled module. */
	free_program(p);
	push_undefined();
      }
    } else {
      /* Initialization failed. */
      new_module->exit();
      dlclose(module);
      dynamic_module_list = new_module->next;
      free_string(new_module->name);
      free(new_module);
      Pike_error("Failed to initialize dynamic module \"%S\".\n",
		 module_name);
    }
  }
}