--- deliantra/server/lib/cf.pm	2007/01/14 12:24:48	1.171
+++ deliantra/server/lib/cf.pm	2007/02/11 22:42:09	1.207
@@ -10,13 +10,14 @@
 use Safe;
 use Safe::Hole;
 
-use Coro 3.3 ();
+use Coro 3.5 ();
 use Coro::Event;
 use Coro::Timer;
 use Coro::Signal;
 use Coro::Semaphore;
 use Coro::AIO;
 
+use BDB ();
 use Data::Dumper;
 use Digest::MD5;
 use Fcntl;
@@ -50,6 +51,10 @@
 our $WRITE_RUNTIME_WATCHER;
 our $NEXT_TICK;
 our $NOW;
+our $USE_FSYNC = 1; # use fsync to write maps - default off
+
+our $BDB_POLL_WATCHER;
+our $DB_ENV;
 
 our %CFG;
 
@@ -60,6 +65,7 @@
 our %MAP;    # all maps
 our $LINK_MAP; # the special {link} map, which is always available
 our $RANDOM_MAPS = cf::localdir . "/random";
+our $BDB_ENV_DIR = cf::localdir . "/db";
 
 our $WAIT_FOR_TICK;     $WAIT_FOR_TICK     ||= new Coro::Signal;
 our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
@@ -82,9 +88,12 @@
 mkdir cf::localdir . "/" . cf::tmpdir;
 mkdir cf::localdir . "/" . cf::uniquedir;
 mkdir $RANDOM_MAPS;
+mkdir $BDB_ENV_DIR;
 
 our $EMERGENCY_POSITION;
 
+sub cf::map::normalise;
+
 #############################################################################
 
 =head2 GLOBAL VARIABLES
@@ -351,10 +360,14 @@
    my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
       or return;
 
-   my $value = $cf::RUNTIME + 1 + 10; # 10 is the runtime save interval, for a monotonic clock
+   my $value = $cf::RUNTIME + 90 + 10;
+   # 10 is the runtime save interval, for a monotonic clock
+   # 60 allows for the watchdog to kill the server.
+
    (aio_write $fh, 0, (length $value), $value, 0) <= 0
       and return;
 
+   # always fsync - this file is important
    aio_fsync $fh
       and return;
 
@@ -749,7 +762,7 @@
          if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
             chmod SAVE_MODE, $fh;
             aio_write $fh, 0, (length $$rdata), $$rdata, 0;
-            aio_fsync $fh;
+            aio_fsync $fh if $cf::USE_FSYNC;
             close $fh;
 
             if (@$objs) {
@@ -757,7 +770,7 @@
                   chmod SAVE_MODE, $fh;
                   my $data = Storable::nfreeze { version => 1, objs => $objs };
                   aio_write $fh, 0, (length $data), $data, 0;
-                  aio_fsync $fh;
+                  aio_fsync $fh if $cf::USE_FSYNC;
                   close $fh;
                   aio_rename "$filename.pst~", "$filename.pst";
                }
@@ -773,6 +786,12 @@
          aio_unlink $filename;
          aio_unlink "$filename.pst";
       }
+
+      #d##TODO# nuke non .map-files if exist
+      if ($filename =~ s/\.map$//) {
+         aio_unlink $filename;
+         aio_unlink "$filename.pst";
+      }
    }
 }
 
@@ -789,6 +808,9 @@
 
    my ($data, $av);
 
+   #d#TODO remove .map if file does not exist
+   aio_stat $filename and $filename =~ s/\.map$//;
+
    (aio_load $filename, $data) >= 0
       or return;
 
@@ -959,7 +981,7 @@
    my ($login) = @_;
 
    $cf::PLAYER{$login}
-      or cf::sync_job { !aio_stat $login }
+      or cf::sync_job { !aio_stat path $login }
 }
 
 sub find($) {
@@ -1067,6 +1089,8 @@
 sub maps($) {
    my ($pl) = @_;
 
+   $pl = ref $pl ? $pl->ob->name : $pl;
+
    my $files = aio_readdir playerdir $pl
       or return;
 
@@ -1077,8 +1101,7 @@
       next if /\.(?:pl|pst)$/;
       next unless /^$PATH_SEP/o;
 
-      s/\.map$//;
-      push @paths, "~" . $pl->ob->name . "/" . $_;
+      push @paths, cf::map::normalise "~$pl/$_";
    }
 
    \@paths
@@ -1115,14 +1138,14 @@
 use Coro::AIO;
 
 use overload
-   '""' => \&as_string;
+   '""'     => \&as_string,
+   fallback => 1;
 
 our $MAX_RESET     = 3600;
 our $DEFAULT_RESET = 3000;
 
 sub generate_random_map {
    my ($self, $rmp) = @_;
-
    # mit "rum" bekleckern, nicht
    $self->_create_random_map (
       $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
@@ -1139,31 +1162,46 @@
    )
 }
 
+=item cf::map->register ($regex, $prio)
+
+Register a handler for the map path matching the given regex at the
+givne priority (higher is better, built-in handlers have priority 0, the
+default).
+
+=cut
+
 sub register {
-   my (undef, $regex) = @_;
+   my (undef, $regex, $prio) = @_;
    my $pkg = caller;
 
    no strict;
    push @{"$pkg\::ISA"}, __PACKAGE__;
 
-   $EXT_MAP{$pkg} = qr<$regex>;
+   $EXT_MAP{$pkg} = [$prio, qr<$regex>];
 }
 
 # also paths starting with '/'
-$EXT_MAP{"cf::map"} = qr{^(?=/)};
+$EXT_MAP{"cf::map"} = [0, qr{^(?=/)}];
 
 sub thawer_merge {
+   my ($self, $merge) = @_;
+
    # we have to keep some variables in memory intact
-   local $_[0]{path};
-   local $_[0]{deny_save};
-   local $_[0]{deny_reset};
+   local $self->{path};
+   local $self->{load_path};
+   local $self->{deny_save};
+   local $self->{deny_reset};
 
-   $_[0]->SUPER::thawer_merge ($_[1]);
+   $self->SUPER::thawer_merge ($merge);
 }
 
 sub normalise {
    my ($path, $base) = @_;
 
+   $path = "$path"; # make sure its a string
+
+   $path =~ s/\.map$//;
+
    # map plan:
    #
    # /!          non-realised random map exit (special hack!)
@@ -1200,8 +1238,8 @@
 
    $path = normalise $path, $base;
 
-   for my $pkg (keys %EXT_MAP) {
-      if ($path =~ $EXT_MAP{$pkg}) {
+   for my $pkg (sort { $EXT_MAP{$b}[0] <=> $EXT_MAP{$a}[0] } keys %EXT_MAP) {
+      if ($path =~ $EXT_MAP{$pkg}[1]) {
          my $self = bless cf::map::new, $pkg;
          $self->{path} = $path; $self->path ($path);
          $self->init; # pass $1 etc.
@@ -1209,7 +1247,7 @@
       }
    }
 
-   Carp::carp "unable to resolve path '$path'.";
+   Carp::carp "unable to resolve path '$path' (base '$base').";
    ()
 }
 
@@ -1234,7 +1272,7 @@
 sub load_path {
    my ($self) = @_;
 
-   sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
+   sprintf "%s/%s/%s.map", cf::datadir, cf::mapdir, $self->{path}
 }
 
 # the temporary/swap location
@@ -1242,7 +1280,7 @@
    my ($self) = @_;
 
    (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
-   sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $path
+   sprintf "%s/%s/%s.map", cf::localdir, cf::tmpdir, $path
 }
 
 # the unique path, undef == no special unique path
@@ -1268,14 +1306,19 @@
    utf8::encode (my $save = $self->save_path);
    IO::AIO::aioreq_pri 4; Coro::AIO::aio_unlink $save;
    IO::AIO::aioreq_pri 4; Coro::AIO::aio_unlink "$save.pst";
+
+   #d#TODO remove .map and also nuke
+   $save =~ s/\.map// or return;#d#
+   IO::AIO::aioreq_pri 4; Coro::AIO::aio_unlink $save;#d#
+   IO::AIO::aioreq_pri 4; Coro::AIO::aio_unlink "$save.pst";#d#
 }
 
 sub load_header_from($) {
    my ($self, $path) = @_;
 
    utf8::encode $path;
-   aio_open $path, O_RDONLY, 0
-      or return;
+   #aio_open $path, O_RDONLY, 0
+   #   or return;
 
    $self->_load_header ($path)
       or return;
@@ -1285,35 +1328,46 @@
    1
 }
 
-sub load_orig {
+sub load_header_orig {
    my ($self) = @_;
 
    $self->load_header_from ($self->load_path)
 }
 
-sub load_temp {
+sub load_header_temp {
    my ($self) = @_;
 
    $self->load_header_from ($self->save_path)
 }
 
+sub prepare_temp {
+   my ($self) = @_;
+
+   $self->last_access ((delete $self->{last_access})
+                       || $cf::RUNTIME); #d#
+   # safety
+   $self->{instantiate_time} = $cf::RUNTIME
+      if $self->{instantiate_time} > $cf::RUNTIME;
+}
+
+sub prepare_orig {
+   my ($self) = @_;
+
+   $self->{load_original} = 1;
+   $self->{instantiate_time} = $cf::RUNTIME;
+   $self->last_access ($cf::RUNTIME);
+   $self->instantiate;
+}
+
 sub load_header {
    my ($self) = @_;
 
-   if ($self->load_temp) {
-      $self->last_access ((delete $self->{last_access})
-                          || $cf::RUNTIME); #d#
-      # safety
-      $self->{instantiate_time} = $cf::RUNTIME
-         if $self->{instantiate_time} > $cf::RUNTIME;
+   if ($self->load_header_temp) {
+      $self->prepare_temp;
    } else {
-      $self->load_orig
+      $self->load_header_orig
          or return;
-
-      $self->{load_original} = 1;
-      $self->{instantiate_time} = $cf::RUNTIME;
-      $self->last_access ($cf::RUNTIME);
-      $self->instantiate;
+      $self->prepare_orig;
    }
 
    1
@@ -1337,21 +1391,26 @@
       $map->load_header
          or return;
 
-      if ($map->should_reset) {
-         $cf::WAIT_FOR_TICK->wait;
+      if ($map->should_reset && 0) {#d#TODO# disabled, crashy (locking issue?)
+         # doing this can freeze the server in a sync job, obviously
+         #$cf::WAIT_FOR_TICK->wait;
          $map->reset;
          undef $guard;
-         $map = find $path
-            or return;
+         return find $path;
       }
 
       $cf::MAP{$path} = $map
    }
 }
 
+sub pre_load  { }
+sub post_load { }
+
 sub load {
    my ($self) = @_;
 
+   local $self->{deny_reset} = 1; # loading can take a long time
+
    my $path = $self->{path};
    my $guard = cf::lock_acquire "map_load:$path";
 
@@ -1360,6 +1419,9 @@
    $self->in_memory (cf::MAP_LOADING);
 
    $self->alloc;
+
+   $self->pre_load;
+
    $self->_load_objects ($self->{load_path}, 1)
       or return;
 
@@ -1391,6 +1453,8 @@
       $self->activate;
    }
 
+   $self->post_load;
+
    $self->in_memory (cf::MAP_IN_MEMORY);
 }
 
@@ -1440,18 +1504,7 @@
 }
 
 our %MAP_PREFETCH;
-our $MAP_PREFETCHER = Coro::async {
-   while () {
-      for my $path (keys %MAP_PREFETCH) {
-         my $map = find $path
-            or next;
-         $map->load;
-
-         delete $MAP_PREFETCH{$path};
-      }
-      Coro::schedule;
-   }
-};
+our $MAP_PREFETCHER = undef;
 
 sub find_async {
    my ($path, $origin) = @_;
@@ -1462,8 +1515,20 @@
       return $map if $map->in_memory == cf::MAP_IN_MEMORY;
    }
 
-   $MAP_PREFETCH{$path} = 0;
-   $MAP_PREFETCHER->ready;
+   undef $MAP_PREFETCH{$path};
+   $MAP_PREFETCHER ||= cf::async {
+      while (%MAP_PREFETCH) {
+         for my $path (keys %MAP_PREFETCH) {
+            my $map = find $path
+               or next;
+            $map->load;
+
+            delete $MAP_PREFETCH{$path};
+         }
+      }
+      undef $MAP_PREFETCHER;
+   };
+   $MAP_PREFETCHER->prio (6);
 
    ()
 }
@@ -1533,20 +1598,6 @@
    $self->reset_at <= $cf::RUNTIME
 }
 
-sub rename {
-   my ($self, $new_path) = @_;
-
-   normalise $new_path;
-
-   $self->unlink_save;
-
-   delete $cf::MAP{$self->path};
-   $self->{path} = $new_path; $self->path ($self->{path});
-   $cf::MAP{$self->path} = $self;
-
-   $self->save;
-}
-
 sub reset {
    my ($self) = @_;
 
@@ -1573,9 +1624,18 @@
 sub nuke {
    my ($self) = @_;
 
+   delete $cf::MAP{$self->path};
+
+   $self->unlink_save;
+
+   bless $self, "cf::map";
+   delete $self->{deny_reset};
    $self->{deny_save} = 1;
    $self->reset_timeout (1);
-   $self->rename ("{nuke}/" . ($nuke_counter++));
+   $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
+
+   $cf::MAP{$self->path} = $self;
+
    $self->reset; # polite request, might not happen
 }
 
@@ -1597,8 +1657,7 @@
       next if /\.pst$/;
       next unless /^$PATH_SEP/o;
 
-      s/\.map$//;
-      push @paths, $_;
+      push @paths, cf::map::normalise $_;
    }
 
    \@paths
@@ -1702,7 +1761,7 @@
 sub link_map {
    unless ($LINK_MAP) {
       $LINK_MAP = cf::map::find "{link}"
-         or do { warn "FATAL: unable to provide {link} map, exiting."; exit 1 };
+         or cf::cleanup "FATAL: unable to provide {link} map, exiting.";
       $LINK_MAP->load;
    }
 
@@ -1719,7 +1778,7 @@
    $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
       if $self->map;
 
-   $self->enter_map ($LINK_MAP || link_map, 20, 20);
+   $self->enter_map ($LINK_MAP || link_map, 10, 10);
 }
 
 sub cf::object::player::leave_link {
@@ -1796,13 +1855,12 @@
    $self->enter_link;
 
    (async {
-      my $map = cf::map::find $path;
-      $map = $map->customise_for ($self) if $map;
-
-#      warn "entering ", $map->path, " at ($x, $y)\n"
-#         if $map;
-
-      $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
+      my $map = eval {
+         my $map = cf::map::find $path;
+         $map = $map->customise_for ($self) if $map;
+         $map
+      } or
+         $self->message ("The exit to '$path' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
 
       $self->leave_link ($map, $x, $y);
    })->prio (1);
@@ -1816,8 +1874,10 @@
    my ($spec) = @_;
 
    my $rmp = { # defaults
-      xsize => 10,
-      ysize => 10,
+      xsize    => (cf::rndm 15, 40),
+      ysize    => (cf::rndm 15, 40),
+      symmetry => (cf::rndm 1, cf::SYMMETRY_XY),
+      #layout   => string,
    };
 
    for (split /\n/, $spec) {
@@ -1832,6 +1892,8 @@
 sub prepare_random_map {
    my ($exit) = @_;
 
+   my $guard = cf::lock_acquire "exit_prepare:$exit";
+
    # all this does is basically replace the /! path by
    # a new random map path (?random/...) with a seed
    # that depends on the exit object
@@ -1839,7 +1901,7 @@
    my $rmp = parse_random_map_params $exit->msg;
 
    if ($exit->map) {
-      $rmp->{region}     = $exit->map->region_name;
+      $rmp->{region}     = $exit->region->name;
       $rmp->{origin_map} = $exit->map->path;
       $rmp->{origin_x}   = $exit->x;
       $rmp->{origin_y}   = $exit->y;
@@ -1849,9 +1911,12 @@
 
    my $data = cf::to_json $rmp;
    my $md5 = Digest::MD5::md5_hex $data;
+   my $meta = "$cf::RANDOM_MAPS/$md5.meta";
 
-   if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) {
+   if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) {
       aio_write $fh, 0, (length $data), $data, 0;
+      undef $fh;
+      aio_rename "$meta~", $meta;
 
       $exit->slaying ("?random/$md5");
       $exit->msg (undef);
@@ -1863,16 +1928,21 @@
 
    return unless $self->type == cf::PLAYER;
 
+   if ($exit->slaying eq "/!") {
+      #TODO: this should de-fi-ni-te-ly not be a sync-job
+      cf::sync_job { prepare_random_map $exit };
+   }
+
+   my $slaying = cf::map::normalise $exit->slaying, $exit->map && $exit->map->path;
+   my $hp      = $exit->stats->hp;
+   my $sp      = $exit->stats->sp;
+
    $self->enter_link;
 
    (async {
       $self->deactivate_recursive; # just to be sure
       unless (eval {
-         prepare_random_map $exit
-            if $exit->slaying eq "/!";
-
-         my $path = new_from_path cf::map $exit->slaying, $exit->map && $exit->map->path;
-         $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
+         $self->goto ($slaying, $hp, $sp);
 
          1;
       }) {
@@ -1943,6 +2013,7 @@
          or return; # be conservative, not sure how that can happen, but we saw a crash here
 
       (shift @$queue)->[1]->($msg);
+      return unless $ns->valid; # temporary(?) workaround for callback destroying socket
 
       push @{ $ns->{query_queue} }, @$queue;
 
@@ -2171,9 +2242,14 @@
       undef $dirty;
    }
 
-   my $idle = Event->idle (min => $TICK * 2.8, max => 10, repeat => 0, data => WF_AUTOCANCEL, cb => sub {
-      db_sync;
-   });
+   my $idle = Event->idle (
+      reentrant => 0,
+      min       => 10,
+      max       => 20,
+      repeat    => 0,
+      data      => WF_AUTOCANCEL,
+      cb        => \&db_sync,
+   );
 
    sub db_dirty() {
       $dirty = 1;
@@ -2204,7 +2280,12 @@
 }
 
 #############################################################################
-# the server's main()
+# the server's init and main functions
+
+sub load_resources {
+   load_regions sprintf "%s/%s/regions", cf::datadir, cf::mapdir
+      or die "unable to load regions file\n";#d#
+}
 
 sub cfg_load {
    open my $fh, "<:utf8", cf::confdir . "/config"
@@ -2227,16 +2308,24 @@
    }
 }
 
+sub init {
+   load_resources;
+}
+
 sub main {
    # we must not ever block the main coroutine
    local $Coro::idle = sub {
       Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
-      async { Event::one_event };
+      (async {
+         Event::one_event;
+      })->prio (Coro::PRIO_MAX);
    };
 
    cfg_load;
    db_load;
    load_extensions;
+
+   $TICK_WATCHER->start;
    Event::loop;
 }
 
@@ -2247,9 +2336,11 @@
 BEGIN {
    for my $signal (qw(INT HUP TERM)) {
       Event->signal (
-         data   => WF_AUTOCANCEL,
-         signal => $signal,
-         cb     => sub {
+         reentrant => 0,
+         data      => WF_AUTOCANCEL,
+         signal    => $signal,
+         prio      => 0,
+         cb        => sub {
             cf::cleanup "SIG$signal";
          },
       );
@@ -2288,39 +2379,47 @@
 sub reload() {
    # can/must only be called in main
    if ($Coro::current != $Coro::main) {
-      warn "can only reload from main coroutine\n";
+      warn "can only reload from main coroutine";
       return;
    }
 
    warn "reloading...";
 
-   warn "freezing server";
-   my $guard = freeze_mainloop;
-   cf::emergency_save;
+   warn "cancelling server ticker";
+   $TICK_WATCHER->cancel;
 
-   warn "sync database to disk";
-   cf::db_sync;
-   IO::AIO::flush;
+   cf::emergency_save;
 
    eval {
       # if anything goes wrong in here, we should simply crash as we already saved
 
-      warn "cancel all watchers";
+      warn "syncing database to disk";
+      cf::db_sync;
+
+      warn "cancelling all WF_AUTOCANCEL watchers";
       for (Event::all_watchers) {
          $_->cancel if $_->data & WF_AUTOCANCEL;
       }
 
-      warn "cancel all extension coros";
+      warn "flushing outstanding aio requests";
+      for (;;) {
+         IO::AIO::flush;
+         Coro::cede;
+         last unless IO::AIO::nreqs;
+         warn "iterate...";
+      }
+
+      warn "cancelling all extension coros";
       $_->cancel for values %EXT_CORO;
       %EXT_CORO = ();
 
-      warn "remove commands";
+      warn "removing commands";
       %COMMAND = ();
 
-      warn "remove ext commands";
+      warn "removing ext commands";
       %EXTCMD = ();
 
-      warn "unload/nuke all extensions";
+      warn "unloading/nuking all extensions";
       for my $pkg (@EXTS) {
          warn "... unloading $pkg";
 
@@ -2335,11 +2434,11 @@
          Symbol::delete_package $pkg;
       }
 
-      warn "unload all perl modules loaded from $LIBDIR";
+      warn "unloading all perl modules loaded from $LIBDIR";
       while (my ($k, $v) = each %INC) {
          next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
 
-         warn "removing <$k>";
+         warn "... unloading $k";
          delete $INC{$k};
 
          $k =~ s/\.pm$//;
@@ -2352,32 +2451,41 @@
          Symbol::delete_package $k;
       }
 
-      warn "get rid of safe::, as good as possible";
+      warn "getting rid of safe::, as good as possible";
       Symbol::delete_package "safe::$_"
          for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
 
-      warn "unload cf.pm \"a bit\"";
+      warn "unloading cf.pm \"a bit\"";
       delete $INC{"cf.pm"};
 
       # don't, removes xs symbols, too,
       # and global variables created in xs
       #Symbol::delete_package __PACKAGE__;
 
+      warn "unload completed, starting to reload now";
+
       warn "reloading cf.pm";
       require cf;
       cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
 
-      warn "load config and database again";
+      warn "loading config and database again";
       cf::cfg_load;
       cf::db_load;
 
-      warn "load extensions";
+      warn "loading extensions";
       cf::load_extensions;
 
-      warn "reattach attachments to objects/players";
+      warn "reattaching attachments to objects/players";
       _global_reattach;
-      warn "reattach attachments to maps";
+      warn "reattaching attachments to maps";
       reattach $_ for values %MAP;
+
+      warn "loading reloadable resources";
+      load_resources;
+
+      warn "restarting server ticker";
+
+      $TICK_WATCHER->start;
    };
 
    if ($@) {
@@ -2389,24 +2497,46 @@
    warn "reloaded";
 };
 
+our $RELOAD_WATCHER; # used only during reload
+
 register_command "reload" => sub {
    my ($who, $arg) = @_;
 
    if ($who->flag (FLAG_WIZ)) {
-      $who->message ("start of reload.");
-      reload;
-      $who->message ("end of reload.");
+      $who->message ("reloading server.");
+
+      # doing reload synchronously and two reloads happen back-to-back,
+      # coro crashes during coro_state_free->destroy here.
+
+      $RELOAD_WATCHER ||= Event->timer (
+         reentrant => 0,
+         after     => 0,
+         data      => WF_AUTOCANCEL,
+         cb => sub {
+            reload;
+            undef $RELOAD_WATCHER;
+         },
+      );
    }
 };
 
 unshift @INC, $LIBDIR;
 
+my $bug_warning = 0;
+
 $TICK_WATCHER = Event->timer (
    reentrant => 0,
+   parked    => 1,
    prio      => 0,
    at        => $NEXT_TICK || $TICK,
    data      => WF_AUTOCANCEL,
    cb        => sub {
+      if ($Coro::current != $Coro::main) {
+         Carp::cluck "major BUG: server tick called outside of main coro, skipping it"
+            unless ++$bug_warning > 10;
+         return;
+      }
+
       $NOW = Event::time;
 
       cf::server_tick; # one server iteration
@@ -2416,6 +2546,12 @@
       $WAIT_FOR_TICK->broadcast;
       $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
 
+      Event::sweep;
+      Coro::cede_notself;
+      
+#      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;
 
@@ -2424,25 +2560,76 @@
    },
 );
 
-IO::AIO::max_poll_time $TICK * 0.2;
+{
+   BDB::max_poll_time $TICK * 0.1;
+   $BDB_POLL_WATCHER = Event->io (
+      reentrant => 0,
+      fd        => BDB::poll_fileno,
+      poll      => 'r',
+      prio      => 0,
+      data      => WF_AUTOCANCEL,
+      cb        => \&BDB::poll_cb,
+   );
+   BDB::min_parallel 8;
 
-$AIO_POLL_WATCHER = Event->io (
-   fd   => IO::AIO::poll_fileno,
-   poll => 'r',
-   prio => 5,
-   data => WF_AUTOCANCEL,
-   cb   => \&IO::AIO::poll_cb,
-);
+   BDB::set_sync_prepare {
+      my $status;
+      my $current = $Coro::current;
+      (
+         sub {
+            $status = $!;
+            $current->ready; undef $current;
+         },
+         sub {
+            Coro::schedule while defined $current;
+            $! = $status;
+         },
+      )
+   };
+
+   unless ($DB_ENV) {
+      $DB_ENV = BDB::db_env_create;
+
+      cf::sync_job {
+         BDB::db_env_open
+            $DB_ENV,
+            $BDB_ENV_DIR,
+            BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL | BDB::INIT_TXN
+            | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE,
+            0666;
+
+         cf::cleanup "$!" if $!;
+            
+         $DB_ENV->set_flags (BDB::AUTO_COMMIT | BDB::REGION_INIT | BDB::TXN_NOSYNC, 1);
+         $DB_ENV->set_lk_detect;
+      };
+   }
+}
+
+{
+   IO::AIO::min_parallel 8;
+
+   undef $Coro::AIO::WATCHER;
+   IO::AIO::max_poll_time $TICK * 0.1;
+   $AIO_POLL_WATCHER = Event->io (
+      reentrant => 0,
+      fd        => IO::AIO::poll_fileno,
+      poll      => 'r',
+      prio      => 6,
+      data      => WF_AUTOCANCEL,
+      cb        => \&IO::AIO::poll_cb,
+   );
+}
 
 $WRITE_RUNTIME_WATCHER = Event->timer (
-   data     => WF_AUTOCANCEL,
-   after    => 0,
-   interval => 10,
-   cb       => sub {
-      (Coro::unblock_sub {
-         write_runtime
-            or warn "ERROR: unable to write runtime file: $!";
-      })->();
+   reentrant => 0,
+   data      => WF_AUTOCANCEL,
+   after     => 1,
+   interval  => 10,
+   prio      => 6,  # keep it lowest so it acts like a watchdog
+   cb        => Coro::unblock_sub {
+      write_runtime
+         or warn "ERROR: unable to write runtime file: $!";
    },
 );