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.496 by root, Sun Nov 15 18:03:59 2009 UTC vs.
Revision 1.502 by root, Sat Jan 23 20:24:50 2010 UTC

… …
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
… …
3141our $safe_hole = new Safe::Hole; 3148our $safe_hole = new Safe::Hole;
3142 3149
3143$SIG{FPE} = 'IGNORE'; 3150$SIG{FPE} = 'IGNORE';
3144 3151
3145$safe->permit_only (Opcode::opset qw( 3152$safe->permit_only (Opcode::opset qw(
3146 :base_core :base_mem :base_orig :base_math 3153 :base_core :base_mem :base_orig :base_math :base_loop
3147 grepstart grepwhile mapstart mapwhile 3154 grepstart grepwhile mapstart mapwhile
3148 sort time 3155 sort time
3149)); 3156));
3150 3157
3151# here we export the classes and methods available to script code 3158# here we export the classes and methods available to script code
… …
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};
… …
3880 3895
3881our @WAIT_FOR_TICK; 3896our @WAIT_FOR_TICK;
3882our @WAIT_FOR_TICK_BEGIN; 3897our @WAIT_FOR_TICK_BEGIN;
3883 3898
3884sub wait_for_tick { 3899sub wait_for_tick {
3885 return if tick_inhibit || $Coro::current == $Coro::main; 3900 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
3886 3901
3887 my $signal = new Coro::Signal; 3902 my $signal = new Coro::Signal;
3888 push @WAIT_FOR_TICK, $signal; 3903 push @WAIT_FOR_TICK, $signal;
3889 $signal->wait; 3904 $signal->wait;
3890} 3905}
3891 3906
3892sub wait_for_tick_begin { 3907sub wait_for_tick_begin {
3893 return if tick_inhibit || $Coro::current == $Coro::main; 3908 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
3894 3909
3895 my $signal = new Coro::Signal; 3910 my $signal = new Coro::Signal;
3896 push @WAIT_FOR_TICK_BEGIN, $signal; 3911 push @WAIT_FOR_TICK_BEGIN, $signal;
3897 $signal->wait; 3912 $signal->wait;
3898} 3913}
… …
3903 unless ++$bug_warning > 10; 3918 unless ++$bug_warning > 10;
3904 return; 3919 return;
3905 } 3920 }
3906 3921
3907 cf::server_tick; # one server iteration 3922 cf::server_tick; # one server iteration
3923
3924 #for(1..3e6){} EV::now_update; $NOW=EV::now; # generate load #d#
3908 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";

Diff Legend

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