--- deliantra/server/lib/cf.pm 2007/04/21 17:34:24 1.257 +++ deliantra/server/lib/cf.pm 2007/06/04 12:19:08 1.273 @@ -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 @@ -175,7 +189,8 @@ @safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; @safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; @safe::cf::map::ISA = @cf::map::ISA = 'cf::attachable'; -@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; +@safe::cf::arch::ISA = @cf::arch::ISA = 'cf::object'; +@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; # not really true (yet) # we bless all objects into (empty) derived classes to force a method lookup # within the Safe compartment. @@ -320,6 +335,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 +357,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 +393,15 @@ } 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. + + IO::AIO::aio_utime $runtime, undef, undef; + + my $guard = cf::lock_acquire "write_runtime"; + my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 or return; @@ -387,12 +416,17 @@ aio_fsync $fh and return; + # touch it again to show we are up-to-date + aio_utime $fh, undef, undef; + close $fh or return; aio_rename "$runtime~", $runtime and return; + warn "runtime file written.\n";#d# + 1 } @@ -594,7 +628,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 +679,7 @@ } else { _attach shift->_attach_registry, @_; } + _recalc_want; }; # all those should be optimised @@ -657,6 +692,7 @@ } else { Carp::croak "cannot, currently, detach class attachments"; } + _recalc_want; }; sub cf::attachable::attached { @@ -1864,10 +1900,12 @@ sub cf::object::player::enter_link { my ($self) = @_; + $self->deactivate_recursive; + return if UNIVERSAL::isa $self->map, "ext::map_link"; $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y] - if $self->map; + if $self->map && $self->map->{path} ne "{link}"; $self->enter_map ($LINK_MAP || link_map, 10, 10); } @@ -1875,6 +1913,8 @@ sub cf::object::player::leave_link { my ($self, $map, $x, $y) = @_; + return unless $self->contr->active; + my $link_pos = delete $self->{_link_pos}; unless ($map) { @@ -1906,56 +1946,48 @@ $self->enter_map ($map, $x, $y); } -cf::player->attach ( - on_logout => sub { - my ($pl) = @_; - - # abort map switching before logout - if ($pl->ob->{_link_pos}) { - cf::sync_job { - $pl->ob->leave_link - }; - } - }, - on_login => sub { - my ($pl) = @_; - - # try to abort aborted map switching on player login :) - # should happen only on crashes - if ($pl->ob->{_link_pos}) { - $pl->ob->enter_link; - (async { - $pl->ob->reply (undef, - "There was an internal problem at your last logout, " - . "the server will try to bring you to your intended destination in a second.", - cf::NDI_RED); - # we need this sleep as the login has a concurrent enter_exit running - # and this sleep increases chances of the player not ending up in scorn - Coro::Timer::sleep 1; - $pl->ob->leave_link; - })->prio (2); - } - }, -); +=item $player_object->goto ($path, $x, $y[, $check->($map)]) -=item $player_object->goto ($path, $x, $y) +Moves the player to the given map-path and coordinates by first freezing +her, loading and preparing them map, calling the provided $check callback +that has to return the map if sucecssful, and then unfreezes the player on +the new (success) or old (failed) map position. =cut +our $GOTOGEN; + sub cf::object::player::goto { - my ($self, $path, $x, $y) = @_; + my ($self, $path, $x, $y, $check) = @_; + + # do generation counting so two concurrent goto's will be executed in-order + my $gen = $self->{_goto_generation} = ++$GOTOGEN; $self->enter_link; (async { my $map = eval { my $map = cf::map::find $path; - $map = $map->customise_for ($self) if $map; + + if ($map) { + $map = $map->customise_for ($self); + $map = $check->($map) if $check && $map; + } else { + $self->message ("The exit to '$path' is closed", cf::NDI_UNIQUE | cf::NDI_RED); + } + $map - } or - $self->message ("The exit to '$path' is closed", cf::NDI_UNIQUE | cf::NDI_RED); + }; - $self->leave_link ($map, $x, $y); + if ($@) { + $self->message ("Something went wrong within the server, please report this incident!", cf::NDI_UNIQUE | cf::NDI_RED); + LOG llevError | logBacktrace, Carp::longmess $@; + } + + if ($gen == $self->{_goto_generation}) { + delete $self->{_goto_generation}; + $self->leave_link ($map, $x, $y); + } })->prio (1); } @@ -2435,9 +2467,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) }; @@ -2449,8 +2482,6 @@ } } - - ############################################################################# # the server's init and main functions @@ -2810,6 +2841,8 @@ $signal->wait; } + my $min = 1e6;#d# + my $avg = 10; $TICK_WATCHER = Event->timer ( reentrant => 0, parked => 1, @@ -2823,10 +2856,33 @@ return; } - $NOW = Event::time; + $NOW = $tick_start = Event::time; cf::server_tick; # one server iteration + 0 && sync_job {#d# + for(1..10) { + my $t = Event::time; + my $map = my $map = new_from_path cf::map "/tmp/x.map" + or die; + + $map->width (50); + $map->height (50); + $map->alloc; + $map->_load_objects ("/tmp/x.map", 1); + my $t = Event::time - $t; + + #next unless $t < 0.0013;#d# + if ($t < $min) { + $min = $t; + } + $avg = $avg * 0.99 + $t * 0.01; + } + warn "XXXXXXXXXXXXXXXXXX min $min avg $avg\n";#d# + exit 0; + # 2007-05-22 02:33:04.569 min 0.00112509727478027 avg 0.0012259249572477 + }; + $RUNTIME += $TICK; $NEXT_TICK += $TICK; @@ -2841,12 +2897,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; } @@ -2854,7 +2904,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; + + }, ); @@ -2923,6 +2986,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;