--- deliantra/server/lib/cf.pm	2007/04/19 16:23:47	1.255
+++ deliantra/server/lib/cf.pm	2007/05/06 05:44:48	1.264
@@ -369,10 +369,19 @@
 }
 
 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.
+
+   warn "touching runtime...\n";#d#
+   if (my $fh = aio_open $runtime, O_WRONLY, 0) {
+      utime undef, undef, $fh;
+   }
+
+   my $guard = cf::lock_acquire "write_runtime";
+
+   warn "starting to write runtime...\n";#d#
    my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
       or return;
 
@@ -387,12 +396,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 "... done writing runtime.\n";#d#
+
    1
 }
 
@@ -1492,53 +1506,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";
+
+      return if $self->in_memory != cf::MAP_SWAPPED;
 
-   $self->in_memory (cf::MAP_LOADING);
+      $self->in_memory (cf::MAP_LOADING);
 
-   $self->alloc;
+      $self->alloc;
 
-   $self->pre_load;
-   Coro::cede;
+      $self->pre_load;
+      Coro::cede;
 
-   $self->_load_objects ($self->{load_path}, 1)
-      or return;
+      $self->_load_objects ($self->{load_path}, 1)
+         or return;
 
-   $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
-      if delete $self->{load_original};
+      $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
+         if delete $self->{load_original};
 
-   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);
+      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);
+         }
       }
-   }
-
-   Coro::cede;
-   # now do the right thing for maps
-   $self->link_multipart_objects;
-   Coro::cede;
 
-   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 +2451,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) };
@@ -2924,6 +2940,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;