ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/map-prefetch.ext
(Generate patch)

Comparing deliantra/maps/perl/map-prefetch.ext (file contents):
Revision 1.1 by root, Mon Jun 26 15:41:12 2006 UTC vs.
Revision 1.8 by root, Sun Jul 16 19:14:10 2006 UTC

… …
7use Errno (); 7use Errno ();
8use Time::HiRes; 8use Time::HiRes;
9use Fcntl; 9use Fcntl;
10use IO::AIO; 10use IO::AIO;
11 11
12Event->io (fd => IO::AIO::poll_fileno,
13 poll => 'r',
14 cb => \&IO::AIO::poll_cb);
15
16# find all potential exit paths, this is slow, so this info is cached
12sub find_exits { 17sub find_exits {
13 my ($map) = @_; 18 my ($map) = @_;
14 19
15 my %exit; 20 my %exit;
16 21
22 # normal exits
17 for my $x (0 .. $map->width - 1) { 23 for my $x (0 .. $map->width - 1) {
18 for my $y (0 .. $map->height - 1) { 24 for my $y (0 .. $map->height - 1) {
19 for (grep $_->type == 66, $map->at ($x, $y)) { 25 for (grep $_->type == 66, $map->at ($x, $y)) {
20 my $path = $_->slaying; 26 my $path = $_->slaying;
21 27
22 next if 3 > length $path; 28 next if 3 > length $path;
23 29
30 # TODO: improve unique exit detection etc.
24 $path = cf::maps_directory cf::path_combine_and_normalize $map->path, $path; 31 $exit{cf::maps_directory cf::path_combine_and_normalize $map->path, $path}++;
25
26 $exit{$path}++;
27 } 32 }
28 } 33 }
34 }
35
36 # tiled maps
37 for (0..3) {
38 my $path = $map->tile_path ($_)
39 or next;
40
41 $exit{cf::maps_directory cf::path_combine_and_normalize $map->path, $path}++;
29 } 42 }
30 43
31 [keys %exit] 44 [keys %exit]
32} 45}
33 46
47my $PREFETCHING;
48my @PREFETCH;
49my %FILE_TIMEOUT;
50
51sub _prefetch;
52
53my $empty_cb = sub { };
54
55sub load_file {
56 my ($path, $cb) = @_;
57
58 my $NOW = Time::HiRes::time;
59
60 aio_open $path, O_RDONLY, 0, sub {
61 my $fh = shift
62 or return $cb->(), _prefetch;
63
64 aio_readahead $fh, 0, -s $fh, sub {
65 my $time = Time::HiRes::time - $NOW;
66 warn "LONG PREFETCH $path $time\n" if $time > 0.3;
67
68 $cb->(), _prefetch;
69 };
70 };
71}
72
73sub prefetch($$;$) {
74 my ($type, $path, $cb) = @_;
75
76 push @PREFETCH, [$type, $path, $cb || $empty_cb];
77 _prefetch unless $PREFETCHING;
78}
79
80sub _prefetch {
81 $PREFETCHING = 1;
82
83 while (@PREFETCH) {
84 my ($type, $path, $cb) = @{ shift @PREFETCH };
85
86 my $NOW = Time::HiRes::time;
87 $cb->(), next if $FILE_TIMEOUT{$path} > $NOW;
88 $FILE_TIMEOUT{$path} = $NOW + 60 + rand 60;
89
90 if ($type eq "map") {
91 if (my $map = cf::map::has_been_loaded $path) {
92 $cb->(), next if $map->in_memory == cf::MAP_IN_MEMORY;
93
94 prefetch file => $map->tmpname
95 if $map->in_memory == cf::MAP_SWAPPED;
96 }
97 }
98
99 load_file $path, $cb;
100 return;
101 }
102
103 $PREFETCHING = 0;
104}
105
34my %MAP_EXITS; 106my %MAP_EXITS;
35my %MAP_TIMEOUT; 107
108sub prefetch_map($) {
109 my ($map) = @_;
110
111 my $exit = $MAP_EXITS{$map->path} ||= find_exits $map;
112 prefetch map => $_ for @$exit;
113}
36 114
37sub on_mapenter { 115sub on_mapenter {
38 my ($ob) = @_; 116 my ($ob) = @_;
39 117
40 my $exit = $MAP_EXITS{$ob->map->path} ||= find_exits $ob->map; 118 prefetch_map $ob->map;
119}
41 120
42 my $NOW = Time::HiRes::time; 121# prefetch a few players/second
122{
123 my @players;
43 124
44 for my $path (@$exit) { 125 Event->timer (interval => 0.2, cb => sub {
45 next if $MAP_TIMEOUT{$path} > $NOW; 126 @players = map $_->ob->name, cf::player::list unless @players;
127 my $player = cf::player::find pop @players
128 or return;
46 129
47 if (my $map = cf::map::has_been_loaded $path) { 130 if (my $map = $player->ob->map) {
48 next if $map->in_memory == cf::MAP_IN_MEMORY; 131 prefetch_map $map;
49
50 $path = $map->tmppath if $map->in_memory == cf::MAP_SWAPPED;
51 } 132 }
52 133
53 $MAP_TIMEOUT{$path} = $NOW + 60 + rand 60; 134 prefetch map => +($player->get_savebed)[0];
54
55 aio_open $path, O_RDONLY, 0, sub {
56 my ($fh) = @_
57 or return;
58 aio_readahead $fh, 0, -s $fh, sub {
59 my $stop = Time::HiRes::time;
60 warn "$path ", $stop-$NOW;
61 };
62 };
63 } 135 });
64} 136}
65 137
66sub on_clock { 138# prefetch all .pl files every few minutes (thats only a "few" megabytes)
67 # boy how I hate polling 139Event->timer (after => 1, interval => 600, cb => sub {
68 IO::AIO::poll_cb; 140 my $playerdir = cf::localdir . "/" . cf::playerdir;
69} 141
142 aio_readdir $playerdir, sub {
143 my ($players) = @_;
144 my $prefetch; $prefetch = sub {
145 my $player = pop @$players
146 or return;
147
148 load_file "$playerdir/$player/$player.pl", $prefetch;
149 };
150
151 $prefetch->(); $prefetch->();
152 };
153});
70 154
71 155
156

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines