--- deliantra/server/lib/cf.pm 2007/04/19 16:23:47 1.255 +++ deliantra/server/lib/cf.pm 2007/05/19 00:08:11 1.267 @@ -92,6 +92,10 @@ # used to convert map paths into valid unix filenames by replacing / by ∕ our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons +our $LOAD; # a number between 0 (idle) and 1 (too many objects) +our $LOADAVG; # same thing, but with alpha-smoothing +our $tick_start; # for load detecting purposes + binmode STDOUT; binmode STDERR; @@ -141,6 +145,16 @@ The interval between server ticks, in seconds. +=item $cf::LOADAVG + +The current CPU load on the server (alpha-smoothed), as a value between 0 +(none) and 1 (overloaded), indicating how much time is spent on processing +objects per tick. Healthy values are < 0.5. + +=item $cf::LOAD + +The raw value load value from the last tick. + =item %cf::CFG Configuration for the server, loaded from C, or @@ -320,6 +334,8 @@ my ($job) = @_; if ($Coro::current == $Coro::main) { + my $time = Event::time; + # this is the main coro, too bad, we have to block # till the operation succeeds, freezing the server :/ @@ -340,6 +356,13 @@ Coro::cede or Event::one_event; } + $time = Event::time - $time; + + LOG llevError | logBacktrace, Carp::longmess "long sync job" + if $time > $TICK * 0.5 && $TICK_WATCHER->is_active; + + $tick_start += $time; # do not account sync jobs to server load + wantarray ? @res : $res[0] } else { # we are in another coroutine, how wonderful, everything just works @@ -369,10 +392,17 @@ } sub write_runtime { - my $guard = cf::lock_acquire "write_runtime"; - my $runtime = "$LOCALDIR/runtime"; + # first touch the runtime file to show we are still running: + # the fsync below can take a very very long time. + + if (my $fh = aio_open $runtime, O_WRONLY, 0) { + utime undef, undef, $fh; + } + + my $guard = cf::lock_acquire "write_runtime"; + my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 or return; @@ -387,12 +417,17 @@ aio_fsync $fh and return; + # touch it again to show we are up-to-date + utime undef, undef, $fh; + close $fh or return; aio_rename "$runtime~", $runtime and return; + warn "runtime file written.\n";#d# + 1 } @@ -594,7 +629,7 @@ } elsif ($type eq "subtype") { defined $object_type or Carp::croak "subtype specified without type"; my $object_subtype = shift @arg; - $registry = $CB_TYPE[$object_type + $object_subtype * NUM_SUBTYPES] ||= []; + $registry = $CB_TYPE[$object_type + $object_subtype * NUM_TYPES] ||= []; } elsif ($type eq "package") { my $pkg = shift @arg; @@ -645,6 +680,7 @@ } else { _attach shift->_attach_registry, @_; } + _recalc_want; }; # all those should be optimised @@ -657,6 +693,7 @@ } else { Carp::croak "cannot, currently, detach class attachments"; } + _recalc_want; }; sub cf::attachable::attached { @@ -1492,53 +1529,54 @@ local $self->{deny_reset} = 1; # loading can take a long time my $path = $self->{path}; - my $guard = cf::lock_acquire "map_load:$path"; - return if $self->in_memory != cf::MAP_SWAPPED; + { + my $guard = cf::lock_acquire "map_load:$path"; - $self->in_memory (cf::MAP_LOADING); + return if $self->in_memory != cf::MAP_SWAPPED; - $self->alloc; + $self->in_memory (cf::MAP_LOADING); - $self->pre_load; - Coro::cede; + $self->alloc; - $self->_load_objects ($self->{load_path}, 1) - or return; + $self->pre_load; + Coro::cede; - $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) - if delete $self->{load_original}; + $self->_load_objects ($self->{load_path}, 1) + or return; - if (my $uniq = $self->uniq_path) { - utf8::encode $uniq; - if (aio_open $uniq, O_RDONLY, 0) { - $self->clear_unique_items; - $self->_load_objects ($uniq, 0); - } - } + $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) + if delete $self->{load_original}; - Coro::cede; - # now do the right thing for maps - $self->link_multipart_objects; - Coro::cede; + if (my $uniq = $self->uniq_path) { + utf8::encode $uniq; + if (aio_open $uniq, O_RDONLY, 0) { + $self->clear_unique_items; + $self->_load_objects ($uniq, 0); + } + } - unless ($self->{deny_activate}) { - $self->decay_objects; - $self->fix_auto_apply; - $self->update_buttons; Coro::cede; - $self->set_darkness_map; + # now do the right thing for maps + $self->link_multipart_objects; $self->difficulty ($self->estimate_difficulty) unless $self->difficulty; Coro::cede; - $self->activate; - Coro::cede; + + unless ($self->{deny_activate}) { + $self->decay_objects; + $self->fix_auto_apply; + $self->update_buttons; + Coro::cede; + $self->set_darkness_map; + Coro::cede; + $self->activate; + } + + $self->in_memory (cf::MAP_IN_MEMORY); } $self->post_load; - Coro::cede; - - $self->in_memory (cf::MAP_IN_MEMORY); } sub customise_for { @@ -2436,9 +2474,10 @@ return wantarray ? @$res : $res->[-1]; } else { + reset_signals; local $SIG{__WARN__}; + local $SIG{__DIE__}; eval { - local $SIG{__DIE__}; close $fh1; my @res = eval { $cb->(@args) }; @@ -2824,7 +2863,7 @@ return; } - $NOW = Event::time; + $NOW = $tick_start = Event::time; cf::server_tick; # one server iteration @@ -2842,12 +2881,6 @@ # my $AFTER = Event::time; # warn $AFTER - $NOW;#d# - # if we are delayed by four ticks or more, skip them all - $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; - - $TICK_WATCHER->at ($NEXT_TICK); - $TICK_WATCHER->start; - if (my $sig = shift @WAIT_FOR_TICK_BEGIN) { $sig->send; } @@ -2855,7 +2888,20 @@ $sig->send; } + $NOW = Event::time; + + # if we are delayed by four ticks or more, skip them all + $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; + + $TICK_WATCHER->at ($NEXT_TICK); + $TICK_WATCHER->start; + + $LOAD = ($NOW - $tick_start) / $TICK; + $LOADAVG = $LOADAVG * 0.75 + $LOAD * 0.25; + _post_tick; + + }, ); @@ -2924,6 +2970,44 @@ ); } +my $_log_backtrace; + +sub _log_backtrace { + my ($msg, @addr) = @_; + + $msg =~ s/\n//; + + # limit the # of concurrent backtraces + if ($_log_backtrace < 2) { + ++$_log_backtrace; + async { + my @bt = fork_call { + @addr = map { sprintf "%x", $_ } @addr; + my $self = (-f "/proc/$$/exe") ? "/proc/$$/exe" : $^X; + open my $fh, "exec addr2line -C -f -i -e \Q$self\E @addr 2>&1 |" + or die "addr2line: $!"; + + my @funcs; + my @res = <$fh>; + chomp for @res; + while (@res) { + my ($func, $line) = splice @res, 0, 2, (); + push @funcs, "[$func] $line"; + } + + @funcs + }; + + LOG llevInfo, "[ABT] $msg\n"; + LOG llevInfo, "[ABT] $_\n" for @bt; + --$_log_backtrace; + }; + } else { + LOG llevInfo, "[ABT] $msg\n"; + LOG llevInfo, "[ABT] [suppressed]\n"; + } +} + # load additional modules use cf::pod;