Front page | perl.perl5.porters |
Postings from August 2001
[PATCH] C Callbacks, try #3
Thread Next
From:
David M. Lloyd
Date:
August 24, 2001 09:50
Subject:
[PATCH] C Callbacks, try #3
Message ID:
Pine.LNX.4.33.0108241128240.11574-100000@homebody.freemm.org
OK, here's my third attempt.
First, let me start of by saying that I changed my implementation 100%,
using pretty much all of Mr. Bergman's ideas. That is, the callbacks are
implemented as an array of function pointers, threads have to do their own
synchronization, etc.
Second, I discovered the #1 bottleneck in performance. It turns out that
it's the function calls. I was able to eliminate all the function calls
except for one, which is the call to the callback itself. So maybe one
alternative is to find a way to call callbacks less often.
Third, I ask that everyone check this patch over extra-carefully to make
sure I am not doing anything that is nonportable (specifically, look at
PERL_ASYNC_CHECK()).
OK, with all that out of the way: here's the benchmarks.
All programs ran over this loop: for $x (1..100_000_000) {}
Times are averaged over five runs.
Unpatched current perl (5.7.2 pl 11734):
Real: 31.1656
User: 31.1600
Sys: 0.0040
Patched current perl (5.7.2 pl 11734) no callbacks:
Real: 33.3060
User: 33.2880
Sys: 0.0120
Patched current perl (5.7.2 pl 11734) one empty callback:
Real: 42.4894
User: 41.9460
Sys: 0.0180
So just applying the patch causes a slowdown of about 7%, and having one
empty callback slows it down by 35%... big bummer.
As far as the 7%, I suspect that the 'if' condition in my current
PERL_ASYNC_CHECK() is not as optimizable as the old one, so it ends up
being more instructions or something.
By moving the body of the comparison in PERL_ASYNC_CHECK() into a
function, the 7% disappears but the 35% increases significantly.
I don't see how I can optimize the empty callback cost any further. It's
the function call itself that is slowing things down, as far as I can
figure out.
So, this is the question: Is 35% to large a price to pay for the ability
for more than one function to overload runops?
Dan Sugalski mentioned that it would be possible to overload certain
opcodes to check a callback status. This would definitely accelerate
things by making callbacks less frequest, but I think I would still like
to do something to hook into waitful periods in waitpid, perlio, etc.
Also, this takes away some of the benefits that one would get from
replacing runops, namely the ability for debuggers, profilers, etc. to
do a unit of work between each opcode.
Let me know your thoughts.
I'm quite close to giving up and just replacing runops for my
application.... and hopefully I won't need to debug or profile my code.
:-)
- D
<dmlloyd@tds.net>
---------- Forwarded message ----------
Date: Fri, 24 Aug 2001 11:25:29 -0500
From: Dave Lloyd <usrodl@tomservo.workpc.tds.net>
--- perl-current/mg.c Sat Aug 18 10:30:25 2001
+++ perl-devel2/mg.c Fri Aug 24 10:49:47 2001
@@ -1047,6 +1047,8 @@
PL_psig_pend[sig]++;
/* And one to say _a_ signal is pending */
PL_sig_pending = 1;
+ /* And yet another to say an event is pending */
+ PL_event_pending = 1;
}
Signal_t
@@ -1066,12 +1068,55 @@
{
int sig;
PL_sig_pending = 0;
+ PL_event_pending = PL_callbacks_end - PL_callbacks;
for (sig = 1; sig < SIG_SIZE; sig++) {
if (PL_psig_pend[sig]) {
PL_psig_pend[sig] = 0;
(*PL_sighandlerp)(sig);
}
}
+}
+
+/*
+=for apidoc add_callback
+
+Add a C callback that will be called after each Perl opcode.
+
+=cut
+*/
+
+void
+Perl_add_callback(pTHX_ void (*callback)(pTHX))
+{
+ if (PL_callbacks == NULL) {
+ New(0,PL_callbacks,(PL_callbacks_size = 8),CALLBACK_t);
+ PL_callbacks_end = PL_callbacks;
+ } else
+ if (PL_callbacks_end >= PL_callbacks + PL_callbacks_size) {
+ IV size = PL_callbacks_end - PL_callbacks;
+ Renew(PL_callbacks, PL_callbacks_size += 8, CALLBACK_t);
+ PL_callbacks_end = PL_callbacks + size;
+ }
+ *(PL_callbacks_end ++) = callback;
+ PL_event_pending = 1;
+}
+
+/*
+=for apidoc remove_callback
+
+Remove a C callback that was added with C<add_callback>.
+
+=cut
+*/
+void
+Perl_remove_callback(pTHX_ void (*callback)(pTHX)) {
+ CALLBACK_t *cb;
+ for (cb = PL_callbacks; cb < PL_callbacks_end; cb ++) {
+ if (*cb == callback) {
+ Move(cb + 1, cb, --PL_callbacks_end - PL_callbacks, CALLBACK_t);
+ }
+ }
+ PL_event_pending = PL_callbacks_end - PL_callbacks + PL_sig_pending;
}
int
--- perl-current/sv.c Sat Aug 18 10:30:25 2001
+++ perl-devel2/sv.c Fri Aug 24 09:15:31 2001
@@ -9646,6 +9646,10 @@
PL_savestack = 0;
PL_retstack = 0;
PL_sig_pending = 0;
+ PL_event_pending = 0;
+ PL_callbacks = NULL;
+ PL_callbacks_end = NULL;
+ PL_callbacks_size = 0;
# else /* !DEBUGGING */
Zero(my_perl, 1, PerlInterpreter);
# endif /* DEBUGGING */
--- perl-current/perl.c Fri Aug 17 00:24:14 2001
+++ perl-devel2/perl.c Fri Aug 24 11:22:56 2001
@@ -230,6 +230,11 @@
(void)PerlIO_close(PerlIO_importFILE(stdprn, 0));
#endif
}
+
+ PL_event_pending = 0;
+ PL_callbacks_end = NULL;
+ PL_callbacks_size = 0;
+ PL_callbacks = NULL;
PL_nrs = newSVpvn("\n", 1);
PL_rs = SvREFCNT_inc(PL_nrs);
@@ -830,6 +835,10 @@
Safefree(PL_reentrant_buffer->tmbuff);
Safefree(PL_reentrant_buffer);
#endif
+
+ /* Get rid of any C callbacks */
+ if (PL_callbacks != NULL)
+ Safefree(PL_callbacks);
sv_free_arenas();
--- perl-current/perl.h Thu Aug 23 00:02:21 2001
+++ perl-devel2/perl.h Fri Aug 24 11:03:23 2001
@@ -3213,6 +3213,7 @@
typedef void (*XSINIT_t) (pTHXo);
typedef void (*ATEXIT_t) (pTHXo_ void*);
typedef void (*XSUBADDR_t) (pTHXo_ CV *);
+typedef void (*CALLBACK_t) (pTHX);
/* Set up PERLVAR macros for populating structs */
#define PERLVAR(var,type) type var;
@@ -3837,11 +3838,16 @@
*/
#ifndef PERL_MICRO
-# ifndef PERL_OLD_SIGNALS
-# ifndef PERL_ASYNC_CHECK
-# define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals()
-# endif
-# endif
+# ifndef PERL_OLD_SIGNALS
+# ifndef PERL_ASYNC_CHECK
+# define PERL_ASYNC_CHECK() \
+ if (PL_event_pending) { \
+ if (PL_sig_pending) despatch_signals(); \
+ for (PL_callback_cur = PL_callbacks; PL_callback_cur < PL_callbacks_end; PL_callback_cur ++) \
+ (*PL_callback_cur)(aTHX); \
+ }
+# endif
+# endif
#endif
#ifndef PERL_ASYNC_CHECK
--- perl-current/embed.pl Fri Aug 17 00:24:14 2001
+++ perl-devel2/embed.pl Fri Aug 24 10:06:14 2001
@@ -2623,6 +2623,8 @@
Apd |char* |sv_pvn_force_flags|SV* sv|STRLEN* lp|I32 flags
Apd |char* |sv_2pv_flags |SV* sv|STRLEN* lp|I32 flags
Ap |char* |my_atof2 |const char *s|NV* value
+Apd |void |add_callback |void (*callback)(pTHX)
+Apd |void |remove_callback|void (*callback)(pTHX)
END_EXTERN_C
--- perl-current/intrpvar.h Sat Aug 18 10:30:25 2001
+++ perl-devel2/intrpvar.h Fri Aug 24 10:11:16 2001
@@ -485,7 +485,12 @@
#endif
-PERLVAR(Isavebegin, bool) /* save BEGINs for compiler */
+PERLVAR(Isavebegin, bool) /* save BEGINs for compiler */
+PERLVAR(Icallbacks_end, CALLBACK_t*) /* first unused callback */
+PERLVAR(Ievent_pending, int) /* event-pending flag */
+PERLVAR(Icallbacks, CALLBACK_t*) /* The callbacks themselves */
+PERLVAR(Icallbacks_size,IV) /* Size of callbacks array */
+PERLVAR(Icallback_cur, CALLBACK_t*) /* Current callback being run */
/* New variables must be added to the very end for binary compatibility.
* XSUB.h provides wrapper functions via perlapi.h that make this
Thread Next
-
[PATCH] C Callbacks, try #3
by David M. Lloyd