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.4 by root, Mon Jun 26 15:44:47 2006 UTC vs.
Revision 1.14 by root, Tue Nov 7 15:04:44 2006 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines