ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/server/cfperl.xs
(Generate patch)

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.313 by pippijn, Tue Dec 23 18:52:58 2008 UTC vs.
Revision 1.314 by root, Thu Jan 1 20:49:48 2009 UTC

405 croak ("perl code used %s object, but C object is already destroyed, caught", klass); 405 croak ("perl code used %s object, but C object is already destroyed, caught", klass);
406 406
407 return (long)mg->mg_ptr; 407 return (long)mg->mg_ptr;
408} 408}
409 409
410static long 410static long noinline
411SvPTR_ornull (SV *sv, const char *klass) 411SvPTR_ornull (SV *sv, const char *klass)
412{ 412{
413 if (SvOK (sv)) 413 if (SvOK (sv))
414 return SvPTR (sv, klass); 414 return SvPTR (sv, klass);
415 else 415 else
607 va_end (ap); 607 va_end (ap);
608 608
609 return sv; 609 return sv;
610} 610}
611 611
612// typemap support, mostly to avoid excessive inlining
613template<class type>
614static void noinline
615cf_obj_to (SV *arg, type &var)
616{
617 sv_to (arg, var);
618 if (!var)
619 croak ("must not pass invalid/null cf_obj here");
620}
621
622template<class object>
623static void noinline
624cf_obj_ornull_to (SV *arg, object *&var)
625{
626 if (SvOK (arg))
627 {
628 sv_to (arg, var);
629 if (!var)
630 croak ("unable to convert perl object to C++ object");
631 }
632 else
633 var = 0;
634}
635
612////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 636//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
613 637
614SV * 638SV *
615registry (attachable *ext) 639registry (attachable *ext)
616{ 640{
660 printf ("unable to bootstrap perl, aborting:\n%s", SvPV_nolen (ERRSV)); 684 printf ("unable to bootstrap perl, aborting:\n%s", SvPV_nolen (ERRSV));
661 exit (EXIT_FAILURE); 685 exit (EXIT_FAILURE);
662 } 686 }
663} 687}
664 688
689void
665void cfperl_main () 690cfperl_main ()
666{ 691{
667 dSP; 692 dSP;
668 693
669 PUSHMARK (SP); 694 PUSHMARK (SP);
670 PUTBACK; 695 PUTBACK;
695# undef def 720# undef def
696}; 721};
697 722
698#define KLASS_OF(event) (((unsigned int)event) < NUM_EVENT_TYPES ? klass_of [event] : KLASS_NONE) 723#define KLASS_OF(event) (((unsigned int)event) < NUM_EVENT_TYPES ? klass_of [event] : KLASS_NONE)
699 724
700static void 725static void noinline
701gather_callbacks (AV *&callbacks, AV *registry, event_type event) 726gather_callbacks (AV *&callbacks, AV *registry, event_type event)
702{ 727{
703 // event must be in array 728 // event must be in array
704 if (event >= 0 && event <= AvFILLp (registry)) 729 if (event >= 0 && event <= AvFILLp (registry))
705 { 730 {
791{ 816{
792 attachable::gather_callbacks (callbacks, event); 817 attachable::gather_callbacks (callbacks, event);
793 ::gather_callbacks (callbacks, cb_map, event); 818 ::gather_callbacks (callbacks, cb_map, event);
794} 819}
795 820
796void 821static void noinline
797_recalc_want (bitset<NUM_EVENT_TYPES> &set, AV *registry) 822_recalc_want (bitset<NUM_EVENT_TYPES> &set, AV *registry)
798{ 823{
799 for (int event = 0; event <= AvFILLp (registry); ++event) 824 for (int event = 0; event <= AvFILLp (registry); ++event)
800 { 825 {
801 SV *cbs_ = AvARRAY (registry)[event]; 826 SV *cbs_ = AvARRAY (registry)[event];
811 } 836 }
812 } 837 }
813} 838}
814 839
815// very slow and inefficient way to recalculate the global want bitsets 840// very slow and inefficient way to recalculate the global want bitsets
816void 841static void
817_recalc_want () 842_recalc_want ()
818{ 843{
819 ev_want_event.reset (); 844 ev_want_event.reset ();
820 845
821 _recalc_want (ev_want_event, cb_global); 846 _recalc_want (ev_want_event, cb_global);
931} 956}
932 957
933///////////////////////////////////////////////////////////////////////////// 958/////////////////////////////////////////////////////////////////////////////
934// various c++ => perl glue functions 959// various c++ => perl glue functions
935 960
961void
936void cfperl_tick () 962cfperl_tick ()
937{ 963{
938 tick_pending = 1; 964 tick_pending = 1;
939 965
940 if (tick_inhibit) 966 if (tick_inhibit)
941 return; 967 return;
1155///////////////////////////////////////////////////////////////////////////// 1181/////////////////////////////////////////////////////////////////////////////
1156 1182
1157struct EVAPI *evapi::GEVAPI; 1183struct EVAPI *evapi::GEVAPI;
1158struct CoroAPI *coroapi::GCoroAPI; 1184struct CoroAPI *coroapi::GCoroAPI;
1159 1185
1186void
1160void coroapi::do_cede_to_tick () 1187coroapi::do_cede_to_tick ()
1161{ 1188{
1162 cede_pending = 0; 1189 cede_pending = 0;
1163 cede (); 1190 cede ();
1164} 1191}
1165 1192
1189 ev_io_set ((ev_io *)this, fd, events); 1216 ev_io_set ((ev_io *)this, fd, events);
1190 if (active) start (); 1217 if (active) start ();
1191 } 1218 }
1192} 1219}
1193 1220
1194void 1221static void
1195_connect_to_perl () 1222_connect_to_perl ()
1196{ 1223{
1197 stash_cf = gv_stashpv ("cf", 1); 1224 stash_cf = gv_stashpv ("cf", 1);
1198 1225
1199 stash_cf_object_wrap = gv_stashpv ("cf::object::wrap", 1); 1226 stash_cf_object_wrap = gv_stashpv ("cf::object::wrap", 1);
2693 PROTOTYPE: $ 2720 PROTOTYPE: $
2694 CODE: 2721 CODE:
2695 RETVAL = region::find (name); 2722 RETVAL = region::find (name);
2696 OUTPUT: RETVAL 2723 OUTPUT: RETVAL
2697 2724
2698region *find_fuzzy (utf8_string name)
2699 PROTOTYPE: $
2700 CODE:
2701 RETVAL = region::find_fuzzy (name);
2702 OUTPUT: RETVAL
2703
2704int specificity (region *rgn) 2725int specificity (region *rgn)
2705 CODE: 2726 CODE:
2706 RETVAL = 0; 2727 RETVAL = 0;
2707 while (rgn = rgn->parent) 2728 while (rgn = rgn->parent)
2708 RETVAL++; 2729 RETVAL++;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines