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.505 by root, Sun Jan 31 03:46:20 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;
… …
1392 . "\n};\n1"; 1399 . "\n};\n1";
1393 1400
1394 $todo{$base} = \%ext; 1401 $todo{$base} = \%ext;
1395 } 1402 }
1396 1403
1404 my $pass = 0;
1397 my %done; 1405 my %done;
1398 while (%todo) { 1406 while (%todo) {
1399 my $progress; 1407 my $progress;
1400 1408
1409 ++$pass;
1410
1411 ext:
1401 while (my ($k, $v) = each %todo) { 1412 while (my ($k, $v) = each %todo) {
1402 for (split /,\s*/, $v->{meta}{depends}) { 1413 for (split /,\s*/, $v->{meta}{depends}) {
1403 goto skip 1414 next ext
1404 unless exists $done{$_}; 1415 unless exists $done{$_};
1405 } 1416 }
1406 1417
1407 warn "... loading '$k' into '$v->{pkg}'\n"; 1418 warn "... pass $pass, loading '$k' into '$v->{pkg}'\n";
1408 1419
1409 unless (eval $v->{source}) { 1420 my $active = eval $v->{source};
1421
1422 if (length $@) {
1410 my $msg = $@ ? "$v->{path}: $@\n" 1423 warn "$v->{path}: $@\n";
1411 : "$v->{base}: extension inactive.\n";
1412 1424
1413 if (exists $v->{meta}{mandatory}) {
1414 warn $msg;
1415 cf::cleanup "mandatory extension failed to load, exiting."; 1425 cf::cleanup "mandatory extension '$k' failed to load, exiting."
1416 } 1426 if exists $v->{meta}{mandatory};
1417 1427 } else {
1418 warn $msg; 1428 $done{$k} = delete $todo{$k};
1429 push @EXTS, $v->{pkg};
1430 $progress = 1;
1431
1432 warn "$v->{base}: extension inactive.\n"
1433 unless $active;
1419 } 1434 }
1420
1421 $done{$k} = delete $todo{$k};
1422 push @EXTS, $v->{pkg};
1423 $progress = 1;
1424 } 1435 }
1425 1436
1426 skip: 1437 unless ($progress) {
1427 die "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n" 1438 warn "cannot load " . (join ", ", keys %todo) . ": unable to resolve dependencies\n";
1428 unless $progress; 1439
1440 while (my ($k, $v) = each %todo) {
1441 cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting."
1442 if exists $v->{meta}{mandatory};
1443 }
1444 }
1429 } 1445 }
1430 }; 1446 };
1431} 1447}
1432 1448
1433############################################################################# 1449#############################################################################
… …
2009 2025
2010 $cf::MAP{$path} = $map 2026 $cf::MAP{$path} = $map
2011 } 2027 }
2012} 2028}
2013 2029
2014sub pre_load { } 2030sub pre_load { }
2015sub post_load { } 2031#sub post_load { } # XS
2016 2032
2017sub load { 2033sub load {
2018 my ($self) = @_; 2034 my ($self) = @_;
2019 2035
2020 local $self->{deny_reset} = 1; # loading can take a long time 2036 local $self->{deny_reset} = 1; # loading can take a long time
… …
3141our $safe_hole = new Safe::Hole; 3157our $safe_hole = new Safe::Hole;
3142 3158
3143$SIG{FPE} = 'IGNORE'; 3159$SIG{FPE} = 'IGNORE';
3144 3160
3145$safe->permit_only (Opcode::opset qw( 3161$safe->permit_only (Opcode::opset qw(
3146 :base_core :base_mem :base_orig :base_math 3162 :base_core :base_mem :base_orig :base_math :base_loop
3147 grepstart grepwhile mapstart mapwhile 3163 grepstart grepwhile mapstart mapwhile
3148 sort time 3164 sort time
3149)); 3165));
3150 3166
3151# here we export the classes and methods available to script code 3167# here we export the classes and methods available to script code
… …
3203 $qcode =~ s/"/‟/g; # not allowed in #line filenames 3219 $qcode =~ s/"/‟/g; # not allowed in #line filenames
3204 $qcode =~ s/\n/\\n/g; 3220 $qcode =~ s/\n/\\n/g;
3205 3221
3206 %vars = (_dummy => 0) unless %vars; 3222 %vars = (_dummy => 0) unless %vars;
3207 3223
3224 my @res;
3208 local $_; 3225 local $_;
3209 local @safe::cf::_safe_eval_args = values %vars;
3210 3226
3211 my $eval = 3227 my $eval =
3212 "do {\n" 3228 "do {\n"
3213 . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" 3229 . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n"
3214 . "#line 0 \"{$qcode}\"\n" 3230 . "#line 0 \"{$qcode}\"\n"
3215 . $code 3231 . $code
3216 . "\n}" 3232 . "\n}"
3217 ; 3233 ;
3218 3234
3235 if ($CFG{safe_eval}) {
3219 sub_generation_inc; 3236 sub_generation_inc;
3237 local @safe::cf::_safe_eval_args = values %vars;
3220 my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); 3238 @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval);
3221 sub_generation_inc; 3239 sub_generation_inc;
3240 } else {
3241 local @cf::_safe_eval_args = values %vars;
3242 @res = wantarray ? eval eval : scalar eval $eval;
3243 }
3222 3244
3223 if ($@) { 3245 if ($@) {
3224 warn "$@"; 3246 warn "$@";
3225 warn "while executing safe code '$code'\n"; 3247 warn "while executing safe code '$code'\n";
3226 warn "with arguments " . (join " ", %vars) . "\n"; 3248 warn "with arguments " . (join " ", %vars) . "\n";
… …
3245=cut 3267=cut
3246 3268
3247sub register_script_function { 3269sub register_script_function {
3248 my ($fun, $cb) = @_; 3270 my ($fun, $cb) = @_;
3249 3271
3250 no strict 'refs'; 3272 $fun = "safe::$fun" if $CFG{safe_eval};
3251 *{"safe::$fun"} = $safe_hole->wrap ($cb); 3273 *$fun = $safe_hole->wrap ($cb);
3252} 3274}
3253 3275
3254=back 3276=back
3255 3277
3256=cut 3278=cut
… …
3277 3299
3278 $facedata->{version} == 2 3300 $facedata->{version} == 2
3279 or cf::cleanup "$path: version mismatch, cannot proceed."; 3301 or cf::cleanup "$path: version mismatch, cannot proceed.";
3280 3302
3281 # patch in the exptable 3303 # patch in the exptable
3304 my $exp_table = $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]);
3282 $facedata->{resource}{"res/exp_table"} = { 3305 $facedata->{resource}{"res/exp_table"} = {
3283 type => FT_RSRC, 3306 type => FT_RSRC,
3284 data => $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]), 3307 data => $exp_table,
3308 hash => (Digest::MD5::md5 $exp_table),
3285 }; 3309 };
3286 cf::cede_to_tick; 3310 cf::cede_to_tick;
3287 3311
3288 { 3312 {
3289 my $faces = $facedata->{faceinfo}; 3313 my $faces = $facedata->{faceinfo};
… …
3556 3580
3557 IO::AIO::aio_utime $RUNTIMEFILE, undef, undef; 3581 IO::AIO::aio_utime $RUNTIMEFILE, undef, undef;
3558 3582
3559 my $guard = cf::lock_acquire "write_runtime"; 3583 my $guard = cf::lock_acquire "write_runtime";
3560 3584
3561 my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT, 0644 3585 my $fh = aio_open "$RUNTIMEFILE~", O_WRONLY | O_CREAT | O_TRUNC, 0644
3562 or return; 3586 or return;
3563 3587
3564 my $value = $cf::RUNTIME + 90 + 10; 3588 my $value = $cf::RUNTIME + 90 + 10;
3565 # 10 is the runtime save interval, for a monotonic clock 3589 # 10 is the runtime save interval, for a monotonic clock
3566 # 60 allows for the watchdog to kill the server. 3590 # 60 allows for the watchdog to kill the server.
… …
3880 3904
3881our @WAIT_FOR_TICK; 3905our @WAIT_FOR_TICK;
3882our @WAIT_FOR_TICK_BEGIN; 3906our @WAIT_FOR_TICK_BEGIN;
3883 3907
3884sub wait_for_tick { 3908sub wait_for_tick {
3885 return if tick_inhibit || $Coro::current == $Coro::main; 3909 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
3886 3910
3887 my $signal = new Coro::Signal; 3911 my $signal = new Coro::Signal;
3888 push @WAIT_FOR_TICK, $signal; 3912 push @WAIT_FOR_TICK, $signal;
3889 $signal->wait; 3913 $signal->wait;
3890} 3914}
3891 3915
3892sub wait_for_tick_begin { 3916sub wait_for_tick_begin {
3893 return if tick_inhibit || $Coro::current == $Coro::main; 3917 return Coro::cede if tick_inhibit || $Coro::current == $Coro::main;
3894 3918
3895 my $signal = new Coro::Signal; 3919 my $signal = new Coro::Signal;
3896 push @WAIT_FOR_TICK_BEGIN, $signal; 3920 push @WAIT_FOR_TICK_BEGIN, $signal;
3897 $signal->wait; 3921 $signal->wait;
3898} 3922}
… …
3903 unless ++$bug_warning > 10; 3927 unless ++$bug_warning > 10;
3904 return; 3928 return;
3905 } 3929 }
3906 3930
3907 cf::server_tick; # one server iteration 3931 cf::server_tick; # one server iteration
3932
3933 #for(1..3e6){} EV::now_update; $NOW=EV::now; # generate load #d#
3908 3934
3909 if ($NOW >= $NEXT_RUNTIME_WRITE) { 3935 if ($NOW >= $NEXT_RUNTIME_WRITE) {
3910 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.; 3936 $NEXT_RUNTIME_WRITE = List::Util::max $NEXT_RUNTIME_WRITE + 10, $NOW + 5.;
3911 Coro::async_pool { 3937 Coro::async_pool {
3912 $Coro::current->{desc} = "runtime saver"; 3938 $Coro::current->{desc} = "runtime saver";
… …
3935} 3961}
3936 3962
3937{ 3963{
3938 # configure BDB 3964 # configure BDB
3939 3965
3940 BDB::min_parallel 8; 3966 BDB::min_parallel 16;
3941 BDB::max_poll_reqs $TICK * 0.1; 3967 BDB::max_poll_reqs $TICK * 0.1;
3942 $AnyEvent::BDB::WATCHER->priority (1); 3968 $AnyEvent::BDB::WATCHER->priority (1);
3943 3969
3944 unless ($DB_ENV) { 3970 unless ($DB_ENV) {
3945 $DB_ENV = BDB::db_env_create; 3971 $DB_ENV = BDB::db_env_create;

Diff Legend

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