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.5 by root, Tue Jun 27 18:22:14 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
43my $PREFETCHING;
35my @PREFETCH; 44my @PREFETCH;
36my %MAP_TIMEOUT; 45my %FILE_TIMEOUT;
37 46
38sub prefetch; 47sub _prefetch;
48
49my $empty_cb = sub { };
50
51sub load_file {
52 my ($path, $cb) = @_;
53
54 my $NOW = Time::HiRes::time;
55
56 aio_open $path, O_RDONLY, 0, sub {
57 my $fh = shift
58 or return $cb->(), _prefetch;
59
60 aio_readahead $fh, 0, -s $fh, sub {
61 my $time = Time::HiRes::time - $NOW;
62 warn "LONG PREFETCH $path $time\n" if $time > 0.3;
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
39sub prefetch { 76sub _prefetch {
40 while (my $path = shift @PREFETCH) { 77 $PREFETCHING = 1;
78
79 while (@PREFETCH) {
80 my ($type, $path, $cb) = @{ shift @PREFETCH };
81
41 my $NOW = Time::HiRes::time; 82 my $NOW = Time::HiRes::time;
83 $cb->(), next if $FILE_TIMEOUT{$path} > $NOW;
84 $FILE_TIMEOUT{$path} = $NOW + 60 + rand 60;
42 85
43 next if $MAP_TIMEOUT{$path} > $NOW; 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;
44 89
45 $MAP_TIMEOUT{$path} = $NOW + 60 + rand 60; 90 prefetch file => $map->tmpname
46
47 if (my $map = cf::map::has_been_loaded $path) {
48 next if $map->in_memory == cf::MAP_IN_MEMORY;
49
50 $path = $map->tmppath if $map->in_memory == cf::MAP_SWAPPED; 91 if $map->in_memory == cf::MAP_SWAPPED;
92 }
51 } 93 }
52 94
53 aio_open $path, O_RDONLY, 0, sub { 95 load_file $path, $cb;
54 my $fh = shift
55 or return; 96 return;
56 aio_readahead $fh, 0, -s $fh, sub { 97 }
57 my $time = Time::HiRes::time - $NOW;
58 warn "LONG PREFETCH $path $time\n" if $time > 0.3;
59 98
60 prefetch; 99 $PREFETCHING = 0;
61 };
62 };
63
64 last;
65 }
66} 100}
67 101
68my %MAP_EXITS; 102my %MAP_EXITS;
69 103
70sub on_mapenter { 104sub prefetch_map($) {
71 my ($ob) = @_; 105 my ($map) = @_;
72 106
73 my $exit = $MAP_EXITS{$ob->map->path} ||= find_exits $ob->map; 107 my $exit = $MAP_EXITS{$map->path} ||= find_exits $map;
74 108 prefetch map => $_ for @$exit;
75 push @PREFETCH, @$exit;
76 prefetch;
77} 109}
78 110
79sub on_clock { 111cf::attach_to_players prio => -900,
80 # boy how I hate polling 112 on_map_change => sub {
81 IO::AIO::poll_cb; 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});
82} 153}
83 154
84 155
156

Diff Legend

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