ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.498 by elmex, Tue Jan 5 16:16:37 2010 UTC vs.
Revision 1.504 by root, Sat Jan 30 23:50:16 2010 UTC

1# 1#
2# This file is part of Deliantra, the Roguelike Realtime MMORPG. 2# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3# 3#
4# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team 4# Copyright (©) 2006,2007,2008,2009,2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5# 5#
6# Deliantra is free software: you can redistribute it and/or modify it under 6# Deliantra is free software: you can redistribute it and/or modify it under
7# the terms of the Affero GNU General Public License as published by the 7# the terms of the Affero GNU General Public License as published by the
8# Free Software Foundation, either version 3 of the License, or (at your 8# Free Software Foundation, either version 3 of the License, or (at your
9# option) any later version. 9# option) any later version.
… …
423 423
424=cut 424=cut
425 425
426our @SLOT_QUEUE; 426our @SLOT_QUEUE;
427our $SLOT_QUEUE; 427our $SLOT_QUEUE;
428our $SLOT_DECAY = 0.9;
428 429
429$SLOT_QUEUE->cancel if $SLOT_QUEUE; 430$SLOT_QUEUE->cancel if $SLOT_QUEUE;
430$SLOT_QUEUE = Coro::async { 431$SLOT_QUEUE = Coro::async {
431 $Coro::current->desc ("timeslot manager"); 432 $Coro::current->desc ("timeslot manager");
432 433
433 my $signal = new Coro::Signal; 434 my $signal = new Coro::Signal;
435 my $busy;
434 436
435 while () { 437 while () {
436 next_job: 438 next_job:
439
437 my $avail = cf::till_tick; 440 my $avail = cf::till_tick;
438 if ($avail > 0.01) { 441
439 for (0 .. $#SLOT_QUEUE) { 442 for (0 .. $#SLOT_QUEUE) {
440 if ($SLOT_QUEUE[$_][0] < $avail) { 443 if ($SLOT_QUEUE[$_][0] <= $avail) {
444 $busy = 0;
441 my $job = splice @SLOT_QUEUE, $_, 1, (); 445 my $job = splice @SLOT_QUEUE, $_, 1, ();
442 $job->[2]->send; 446 $job->[2]->send;
443 Coro::cede; 447 Coro::cede;
444 goto next_job; 448 goto next_job;
445 } 449 } else {
450 $SLOT_QUEUE[$_][0] *= $SLOT_DECAY;
446 } 451 }
447 } 452 }
448 453
449 if (@SLOT_QUEUE) { 454 if (@SLOT_QUEUE) {
450 # we do not use wait_for_tick() as it returns immediately when tick is inactive 455 # we do not use wait_for_tick() as it returns immediately when tick is inactive
451 push @cf::WAIT_FOR_TICK, $signal; 456 push @cf::WAIT_FOR_TICK, $signal;
452 $signal->wait; 457 $signal->wait;
453 } else { 458 } else {
459 $busy = 0;
454 Coro::schedule; 460 Coro::schedule;
455 } 461 }
456 } 462 }
457}; 463};
458 464
459sub get_slot($;$$) { 465sub get_slot($;$$) {
460 return if tick_inhibit || $Coro::current == $Coro::main; 466 return if tick_inhibit || $Coro::current == $Coro::main;
461 467
462 my ($time, $pri, $name) = @_; 468 my ($time, $pri, $name) = @_;
463 469
464 $time = $TICK * .6 if $time > $TICK * .6; 470 $time = clamp $time, 0.01, $TICK * .6;
471
465 my $sig = new Coro::Signal; 472 my $sig = new Coro::Signal;
466 473
467 push @SLOT_QUEUE, [$time, $pri, $sig, $name]; 474 push @SLOT_QUEUE, [$time, $pri, $sig, $name];
468 @SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE; 475 @SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE;
469 $SLOT_QUEUE->ready; 476 $SLOT_QUEUE->ready;
… …
2009 2016
2010 $cf::MAP{$path} = $map 2017 $cf::MAP{$path} = $map
2011 } 2018 }
2012} 2019}
2013 2020
2014sub pre_load { } 2021sub pre_load { }
2015sub post_load { } 2022#sub post_load { } # XS
2016 2023
2017sub load { 2024sub load {
2018 my ($self) = @_; 2025 my ($self) = @_;
2019 2026
2020 local $self->{deny_reset} = 1; # loading can take a long time 2027 local $self->{deny_reset} = 1; # loading can take a long time
… …
3203 $qcode =~ s/"/‟/g; # not allowed in #line filenames 3210 $qcode =~ s/"/‟/g; # not allowed in #line filenames
3204 $qcode =~ s/\n/\\n/g; 3211 $qcode =~ s/\n/\\n/g;
3205 3212
3206 %vars = (_dummy => 0) unless %vars; 3213 %vars = (_dummy => 0) unless %vars;
3207 3214
3215 my @res;
3208 local $_; 3216 local $_;
3209 local @safe::cf::_safe_eval_args = values %vars;
3210 3217
3211 my $eval = 3218 my $eval =
3212 "do {\n" 3219 "do {\n"
3213 . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" 3220 . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n"
3214 . "#line 0 \"{$qcode}\"\n" 3221 . "#line 0 \"{$qcode}\"\n"
3215 . $code 3222 . $code
3216 . "\n}" 3223 . "\n}"
3217 ; 3224 ;
3218 3225
3226 if ($CFG{safe_eval}) {
3219 sub_generation_inc; 3227 sub_generation_inc;
3228 local @safe::cf::_safe_eval_args = values %vars;
3220 my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); 3229 @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval);
3221 sub_generation_inc; 3230 sub_generation_inc;
3231 } else {
3232 local @cf::_safe_eval_args = values %vars;
3233 @res = wantarray ? eval eval : scalar eval $eval;
3234 }
3222 3235
3223 if ($@) { 3236 if ($@) {
3224 warn "$@"; 3237 warn "$@";
3225 warn "while executing safe code '$code'\n"; 3238 warn "while executing safe code '$code'\n";
3226 warn "with arguments " . (join " ", %vars) . "\n"; 3239 warn "with arguments " . (join " ", %vars) . "\n";
… …
3245=cut 3258=cut
3246 3259
3247sub register_script_function { 3260sub register_script_function {
3248 my ($fun, $cb) = @_; 3261 my ($fun, $cb) = @_;
3249 3262
3250 no strict 'refs'; 3263 $fun = "safe::$fun" if $CFG{safe_eval};
3251 *{"safe::$fun"} = $safe_hole->wrap ($cb); 3264 *$fun = $safe_hole->wrap ($cb);
3252} 3265}
3253 3266
3254=back 3267=back
3255 3268
3256=cut 3269=cut
… …
3277 3290
3278 $facedata->{version} == 2 3291 $facedata->{version} == 2
3279 or cf::cleanup "$path: version mismatch, cannot proceed."; 3292 or cf::cleanup "$path: version mismatch, cannot proceed.";
3280 3293
3281 # patch in the exptable 3294 # patch in the exptable
3295 my $exp_table = $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]);
3282 $facedata->{resource}{"res/exp_table"} = { 3296 $facedata->{resource}{"res/exp_table"} = {
3283 type => FT_RSRC, 3297 type => FT_RSRC,
3284 data => $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]), 3298 data => $exp_table,
3299 hash => (Digest::MD5::md5 $exp_table),
3285 }; 3300 };
3286 cf::cede_to_tick; 3301 cf::cede_to_tick;
3287 3302
3288 { 3303 {
3289 my $faces = $facedata->{faceinfo}; 3304 my $faces = $facedata->{faceinfo};
… …
3904 return; 3919 return;
3905 } 3920 }
3906 3921
3907 cf::server_tick; # one server iteration 3922 cf::server_tick; # one server iteration
3908 3923
3924 #for(1..3e6){} EV::now_update; $NOW=EV::now; # generate load #d#
3925
3909 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3926 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3910 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 3927 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3911 Coro::async_pool { 3928 Coro::async_pool {
3912 $Coro::current->{desc} = "runtime saver"; 3929 $Coro::current->{desc} = "runtime saver";
3913 write_runtime_sync 3930 write_runtime_sync
… …
3935} 3952}
3936 3953
3937{ 3954{
3938 # configure BDB 3955 # configure BDB
3939 3956
3940 BDB::min_parallel 8; 3957 BDB::min_parallel 16;
3941 BDB::max_poll_reqs $TICK * 0.1; 3958 BDB::max_poll_reqs $TICK * 0.1;
3942 $AnyEvent::BDB::WATCHER->priority (1); 3959 $AnyEvent::BDB::WATCHER->priority (1);
3943 3960
3944 unless ($DB_ENV) { 3961 unless ($DB_ENV) {
3945 $DB_ENV = BDB::db_env_create; 3962 $DB_ENV = BDB::db_env_create;

Diff Legend

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