… | |
… | |
33 | # define setjmp _setjmp /* deep magic */ |
33 | # define setjmp _setjmp /* deep magic */ |
34 | #else |
34 | #else |
35 | # include <inttypes.h> /* most portable stdint.h */ |
35 | # include <inttypes.h> /* most portable stdint.h */ |
36 | #endif |
36 | #endif |
37 | |
37 | |
38 | #ifdef HAVE_MMAP |
38 | #if HAVE_MMAP |
39 | # include <unistd.h> |
39 | # include <unistd.h> |
40 | # include <sys/mman.h> |
40 | # include <sys/mman.h> |
41 | # ifndef MAP_ANONYMOUS |
41 | # ifndef MAP_ANONYMOUS |
42 | # ifdef MAP_ANON |
42 | # ifdef MAP_ANON |
43 | # define MAP_ANONYMOUS MAP_ANON |
43 | # define MAP_ANONYMOUS MAP_ANON |
… | |
… | |
212 | #define VARx(name,expr,type) type name; |
212 | #define VARx(name,expr,type) type name; |
213 | # include "state.h" |
213 | # include "state.h" |
214 | #undef VARx |
214 | #undef VARx |
215 | } perl_slots; |
215 | } perl_slots; |
216 | |
216 | |
217 | // how many context stack entries do we need for perl_slots |
217 | /* how many context stack entries do we need for perl_slots */ |
218 | #define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT)) |
218 | #define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT)) |
219 | |
219 | |
220 | /* this is a structure representing a perl-level coroutine */ |
220 | /* this is a structure representing a perl-level coroutine */ |
221 | struct coro |
221 | struct coro |
222 | { |
222 | { |
… | |
… | |
291 | #define coro_nready coroapi.nready |
291 | #define coro_nready coroapi.nready |
292 | |
292 | |
293 | /** JIT *********************************************************************/ |
293 | /** JIT *********************************************************************/ |
294 | |
294 | |
295 | #if CORO_JIT |
295 | #if CORO_JIT |
|
|
296 | /* APPLE doesn't have HAVE_MMAP though */ |
|
|
297 | #define CORO_JIT_UNIXY (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris || __APPLE__) |
296 | #ifndef CORO_JIT_TYPE |
298 | #ifndef CORO_JIT_TYPE |
297 | #if __x86_64 && (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris) |
299 | #if __x86_64 && CORO_JIT_UNIXY |
298 | #define CORO_JIT_TYPE "amd64-unix" |
300 | #define CORO_JIT_TYPE "amd64-unix" |
299 | typedef void (*load_save_perl_slots_type)(perl_slots *); |
301 | #elif __i386 && CORO_JIT_UNIXY |
300 | #elif __i386 && (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris) |
|
|
301 | #define CORO_JIT_TYPE "x86-unix" |
302 | #define CORO_JIT_TYPE "x86-unix" |
302 | typedef void (*load_save_perl_slots_type)(perl_slots *); |
|
|
303 | #else |
|
|
304 | x x x x |
|
|
305 | #undef CORO_JIT |
|
|
306 | #endif |
303 | #endif |
307 | #endif |
304 | #endif |
308 | #endif |
305 | #endif |
309 | |
306 | |
|
|
307 | #if !defined(CORO_JIT_TYPE) || !HAVE_MMAP |
|
|
308 | #undef CORO_JIT |
|
|
309 | #endif |
|
|
310 | |
310 | #if CORO_JIT |
311 | #if CORO_JIT |
|
|
312 | typedef void (*load_save_perl_slots_type)(perl_slots *); |
311 | static load_save_perl_slots_type load_perl_slots, save_perl_slots; |
313 | static load_save_perl_slots_type load_perl_slots, save_perl_slots; |
312 | #endif |
314 | #endif |
313 | |
315 | |
314 | /** Coro::Select ************************************************************/ |
316 | /** Coro::Select ************************************************************/ |
315 | |
317 | |
316 | static OP *(*coro_old_pp_sselect) (pTHX); |
318 | static OP *(*coro_old_pp_sselect) (pTHX); |
… | |
… | |
344 | ret [0] = tv.tv_sec; |
346 | ret [0] = tv.tv_sec; |
345 | ret [1] = tv.tv_usec; |
347 | ret [1] = tv.tv_usec; |
346 | } |
348 | } |
347 | |
349 | |
348 | ECB_INLINE double |
350 | ECB_INLINE double |
349 | coro_nvtime () |
351 | coro_nvtime (void) |
350 | { |
352 | { |
351 | struct timeval tv; |
353 | struct timeval tv; |
352 | gettimeofday (&tv, 0); |
354 | gettimeofday (&tv, 0); |
353 | |
355 | |
354 | return tv.tv_sec + tv.tv_usec * 1e-6; |
356 | return tv.tv_sec + tv.tv_usec * 1e-6; |
… | |
… | |
414 | #endif |
416 | #endif |
415 | return get_hv (name, create); |
417 | return get_hv (name, create); |
416 | } |
418 | } |
417 | |
419 | |
418 | ECB_INLINE void |
420 | ECB_INLINE void |
419 | coro_times_update () |
421 | coro_times_update (void) |
420 | { |
422 | { |
421 | #ifdef coro_clock_gettime |
423 | #ifdef coro_clock_gettime |
422 | struct timespec ts; |
424 | struct timespec ts; |
423 | |
425 | |
424 | ts.tv_sec = ts.tv_nsec = 0; |
426 | ts.tv_sec = ts.tv_nsec = 0; |
… | |
… | |
1188 | /* restore swapped sv's */ |
1190 | /* restore swapped sv's */ |
1189 | SWAP_SVS (coro); |
1191 | SWAP_SVS (coro); |
1190 | |
1192 | |
1191 | coro_destruct_stacks (aTHX); |
1193 | coro_destruct_stacks (aTHX); |
1192 | |
1194 | |
1193 | // now save some sv's to be free'd later |
1195 | /* now save some sv's to be free'd later */ |
1194 | svf [0] = GvSV (PL_defgv); |
1196 | svf [0] = GvSV (PL_defgv); |
1195 | svf [1] = (SV *)GvAV (PL_defgv); |
1197 | svf [1] = (SV *)GvAV (PL_defgv); |
1196 | svf [2] = GvSV (PL_errgv); |
1198 | svf [2] = GvSV (PL_errgv); |
1197 | svf [3] = (SV *)PL_defoutgv; |
1199 | svf [3] = (SV *)PL_defoutgv; |
1198 | svf [4] = PL_rs; |
1200 | svf [4] = PL_rs; |
… | |
… | |
1441 | JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ |
1443 | JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ |
1442 | } |
1444 | } |
1443 | } |
1445 | } |
1444 | |
1446 | |
1445 | static coro_cctx * |
1447 | static coro_cctx * |
1446 | cctx_new () |
1448 | cctx_new (void) |
1447 | { |
1449 | { |
1448 | coro_cctx *cctx; |
1450 | coro_cctx *cctx; |
1449 | |
1451 | |
1450 | ++cctx_count; |
1452 | ++cctx_count; |
1451 | New (0, cctx, 1, coro_cctx); |
1453 | New (0, cctx, 1, coro_cctx); |
… | |
… | |
1457 | return cctx; |
1459 | return cctx; |
1458 | } |
1460 | } |
1459 | |
1461 | |
1460 | /* create a new cctx only suitable as source */ |
1462 | /* create a new cctx only suitable as source */ |
1461 | static coro_cctx * |
1463 | static coro_cctx * |
1462 | cctx_new_empty () |
1464 | cctx_new_empty (void) |
1463 | { |
1465 | { |
1464 | coro_cctx *cctx = cctx_new (); |
1466 | coro_cctx *cctx = cctx_new (); |
1465 | |
1467 | |
1466 | cctx->sptr = 0; |
1468 | cctx->sptr = 0; |
1467 | coro_create (&cctx->cctx, 0, 0, 0, 0); |
1469 | coro_create (&cctx->cctx, 0, 0, 0, 0); |
… | |
… | |
1469 | return cctx; |
1471 | return cctx; |
1470 | } |
1472 | } |
1471 | |
1473 | |
1472 | /* create a new cctx suitable as destination/running a perl interpreter */ |
1474 | /* create a new cctx suitable as destination/running a perl interpreter */ |
1473 | static coro_cctx * |
1475 | static coro_cctx * |
1474 | cctx_new_run () |
1476 | cctx_new_run (void) |
1475 | { |
1477 | { |
1476 | coro_cctx *cctx = cctx_new (); |
1478 | coro_cctx *cctx = cctx_new (); |
1477 | void *stack_start; |
1479 | void *stack_start; |
1478 | size_t stack_size; |
1480 | size_t stack_size; |
1479 | |
1481 | |
1480 | #if HAVE_MMAP |
1482 | #if HAVE_MMAP |
1481 | cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; |
1483 | cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; |
1482 | /* mmap supposedly does allocate-on-write for us */ |
1484 | /* mmap supposedly does allocate-on-write for us */ |
1483 | cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); |
1485 | cctx->sptr = mmap (0, cctx->ssize, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, 0, 0); |
1484 | |
1486 | |
1485 | if (cctx->sptr != (void *)-1) |
1487 | if (cctx->sptr != (void *)-1) |
1486 | { |
1488 | { |
1487 | #if CORO_STACKGUARD |
1489 | #if CORO_STACKGUARD |
1488 | mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE); |
1490 | mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE); |
… | |
… | |
2951 | { |
2953 | { |
2952 | int i; |
2954 | int i; |
2953 | /* if we were woken up but can't down, we look through the whole */ |
2955 | /* if we were woken up but can't down, we look through the whole */ |
2954 | /* waiters list and only add us if we aren't in there already */ |
2956 | /* waiters list and only add us if we aren't in there already */ |
2955 | /* this avoids some degenerate memory usage cases */ |
2957 | /* this avoids some degenerate memory usage cases */ |
2956 | for (i = AvFILLp (av); i > 0; --i) // i > 0 is not an off-by-one bug |
2958 | for (i = AvFILLp (av); i > 0; --i) /* i > 0 is not an off-by-one bug */ |
2957 | if (AvARRAY (av)[i] == coro_hv) |
2959 | if (AvARRAY (av)[i] == coro_hv) |
2958 | return 1; |
2960 | return 1; |
2959 | |
2961 | |
2960 | av_push (av, SvREFCNT_inc (coro_hv)); |
2962 | av_push (av, SvREFCNT_inc (coro_hv)); |
2961 | return 1; |
2963 | return 1; |
… | |
… | |
3362 | { |
3364 | { |
3363 | dSP; |
3365 | dSP; |
3364 | SV *load, *save; |
3366 | SV *load, *save; |
3365 | char *map_base; |
3367 | char *map_base; |
3366 | char *load_ptr, *save_ptr; |
3368 | char *load_ptr, *save_ptr; |
3367 | STRLEN load_len, save_len; |
3369 | STRLEN load_len, save_len, map_len; |
3368 | int count; |
3370 | int count; |
3369 | |
3371 | |
3370 | eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1); |
3372 | eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1); |
3371 | |
3373 | |
3372 | PUSHMARK (SP); |
3374 | PUSHMARK (SP); |
… | |
… | |
3377 | SPAGAIN; |
3379 | SPAGAIN; |
3378 | |
3380 | |
3379 | save = POPs; save_ptr = SvPVbyte (save, save_len); |
3381 | save = POPs; save_ptr = SvPVbyte (save, save_len); |
3380 | load = POPs; load_ptr = SvPVbyte (load, load_len); |
3382 | load = POPs; load_ptr = SvPVbyte (load, load_len); |
3381 | |
3383 | |
|
|
3384 | map_len = load_len + save_len + 16; |
|
|
3385 | |
3382 | map_base = mmap (0, load_len + save_len + 16, PROT_EXEC | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); |
3386 | map_base = mmap (0, map_len, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); |
3383 | |
3387 | |
3384 | assert (("Coro: unable to mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED)); |
3388 | assert (("Coro: unable to mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED)); |
3385 | |
3389 | |
3386 | load_perl_slots = (load_save_perl_slots_type)map_base; |
3390 | load_perl_slots = (load_save_perl_slots_type)map_base; |
3387 | memcpy (map_base, load_ptr, load_len); |
3391 | memcpy (map_base, load_ptr, load_len); |
3388 | |
3392 | |
3389 | map_base += (load_len + 15) & ~15; |
3393 | map_base += (load_len + 15) & ~15; |
3390 | |
3394 | |
3391 | save_perl_slots = (load_save_perl_slots_type)map_base; |
3395 | save_perl_slots = (load_save_perl_slots_type)map_base; |
3392 | memcpy (map_base, save_ptr, save_len); |
3396 | memcpy (map_base, save_ptr, save_len); |
|
|
3397 | |
|
|
3398 | /* we are good citizens and try to make the page read-only, so the evil evil */ |
|
|
3399 | /* hackers might have it a bit more difficult */ |
|
|
3400 | mprotect (map_base, map_len, PROT_READ | PROT_EXEC); |
3393 | |
3401 | |
3394 | PUTBACK; |
3402 | PUTBACK; |
3395 | eval_pv ("undef &Coro::State::_jit", 1); |
3403 | eval_pv ("undef &Coro::State::_jit", 1); |
3396 | } |
3404 | } |
3397 | |
3405 | |