… | |
… | |
166 | static struct CoroAPI coroapi; |
166 | static struct CoroAPI coroapi; |
167 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
167 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
168 | static JMPENV *main_top_env; |
168 | static JMPENV *main_top_env; |
169 | static HV *coro_state_stash, *coro_stash; |
169 | static HV *coro_state_stash, *coro_stash; |
170 | static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */ |
170 | static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */ |
171 | static volatile struct coro *transfer_next; |
|
|
172 | |
171 | |
173 | static GV *irsgv; /* $/ */ |
172 | static GV *irsgv; /* $/ */ |
174 | static GV *stdoutgv; /* *STDOUT */ |
173 | static GV *stdoutgv; /* *STDOUT */ |
175 | static SV *rv_diehook; |
174 | static SV *rv_diehook; |
176 | static SV *rv_warnhook; |
175 | static SV *rv_warnhook; |
… | |
… | |
1087 | |
1086 | |
1088 | /* the tail of transfer: execute stuff we can only do after a transfer */ |
1087 | /* the tail of transfer: execute stuff we can only do after a transfer */ |
1089 | INLINE void |
1088 | INLINE void |
1090 | transfer_tail (pTHX) |
1089 | transfer_tail (pTHX) |
1091 | { |
1090 | { |
1092 | struct coro *next = (struct coro *)transfer_next; |
|
|
1093 | assert (!(transfer_next = 0)); /* just used for the side effect when asserts are enabled */ |
|
|
1094 | assert (("FATAL: next coroutine was zero in transfer_tail (please report)", next)); |
|
|
1095 | |
|
|
1096 | free_coro_mortal (aTHX); |
1091 | free_coro_mortal (aTHX); |
1097 | |
|
|
1098 | if (expect_false (next->throw)) |
|
|
1099 | { |
|
|
1100 | SV *exception = sv_2mortal (next->throw); |
|
|
1101 | |
|
|
1102 | next->throw = 0; |
|
|
1103 | sv_setsv (ERRSV, exception); |
|
|
1104 | croak (0); |
|
|
1105 | } |
|
|
1106 | } |
1092 | } |
1107 | |
1093 | |
1108 | /* |
1094 | /* |
1109 | * this is a _very_ stripped down perl interpreter ;) |
1095 | * this is a _very_ stripped down perl interpreter ;) |
1110 | */ |
1096 | */ |
… | |
… | |
1125 | |
1111 | |
1126 | /* inject a fake subroutine call to cctx_init */ |
1112 | /* inject a fake subroutine call to cctx_init */ |
1127 | cctx_prepare (aTHX_ (coro_cctx *)arg); |
1113 | cctx_prepare (aTHX_ (coro_cctx *)arg); |
1128 | |
1114 | |
1129 | /* cctx_run is the alternative tail of transfer() */ |
1115 | /* cctx_run is the alternative tail of transfer() */ |
1130 | /* TODO: throwing an exception here might be deadly, VERIFY */ |
|
|
1131 | transfer_tail (aTHX); |
1116 | transfer_tail (aTHX); |
1132 | |
1117 | |
1133 | /* somebody or something will hit me for both perl_run and PL_restartop */ |
1118 | /* somebody or something will hit me for both perl_run and PL_restartop */ |
1134 | PL_restartop = PL_op; |
1119 | PL_restartop = PL_op; |
1135 | perl_run (PL_curinterp); |
1120 | perl_run (PL_curinterp); |
… | |
… | |
1376 | |
1361 | |
1377 | ++next->usecount; |
1362 | ++next->usecount; |
1378 | |
1363 | |
1379 | if (expect_true (!next->cctx)) |
1364 | if (expect_true (!next->cctx)) |
1380 | next->cctx = cctx_get (aTHX); |
1365 | next->cctx = cctx_get (aTHX); |
1381 | |
|
|
1382 | assert (("FATAL: transfer_next already nonzero in Coro (please report)", !transfer_next)); |
|
|
1383 | transfer_next = next; |
|
|
1384 | |
1366 | |
1385 | if (expect_false (prev__cctx != next->cctx)) |
1367 | if (expect_false (prev__cctx != next->cctx)) |
1386 | { |
1368 | { |
1387 | prev__cctx->top_env = PL_top_env; |
1369 | prev__cctx->top_env = PL_top_env; |
1388 | PL_top_env = next->cctx->top_env; |
1370 | PL_top_env = next->cctx->top_env; |
… | |
… | |
1832 | slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta) |
1814 | slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta) |
1833 | { |
1815 | { |
1834 | SV **arg = (SV **)slf_frame.data; |
1816 | SV **arg = (SV **)slf_frame.data; |
1835 | |
1817 | |
1836 | prepare_transfer (aTHX_ ta, arg [0], arg [1]); |
1818 | prepare_transfer (aTHX_ ta, arg [0], arg [1]); |
|
|
1819 | |
|
|
1820 | /* if the destination has ->throw set, then copy it */ |
|
|
1821 | /* into the current coro's throw slot, so it will be raised */ |
|
|
1822 | /* after the schedule */ |
|
|
1823 | if (expect_false (ta->next->throw)) |
|
|
1824 | { |
|
|
1825 | struct coro *coro = SvSTATE_current; |
|
|
1826 | SvREFCNT_dec (coro->throw); |
|
|
1827 | coro->throw = ta->next->throw; |
|
|
1828 | ta->next->throw = 0; |
|
|
1829 | } |
1837 | } |
1830 | } |
1838 | |
1831 | |
1839 | static void |
1832 | static void |
1840 | slf_init_transfer (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) |
1833 | slf_init_transfer (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items) |
1841 | { |
1834 | { |
… | |
… | |
1896 | /* do a quick consistency check on the "function" object, and if it isn't */ |
1889 | /* do a quick consistency check on the "function" object, and if it isn't */ |
1897 | /* for us, divert to the real entersub */ |
1890 | /* for us, divert to the real entersub */ |
1898 | if (SvTYPE (gv) != SVt_PVGV || !(CvFLAGS (GvCV (gv)) & CVf_SLF)) |
1891 | if (SvTYPE (gv) != SVt_PVGV || !(CvFLAGS (GvCV (gv)) & CVf_SLF)) |
1899 | return PL_ppaddr[OP_ENTERSUB](aTHX); |
1892 | return PL_ppaddr[OP_ENTERSUB](aTHX); |
1900 | |
1893 | |
1901 | /* pop args */ |
|
|
1902 | SP = PL_stack_base + POPMARK; |
|
|
1903 | |
|
|
1904 | if (!(PL_op->op_flags & OPf_STACKED)) |
1894 | if (!(PL_op->op_flags & OPf_STACKED)) |
1905 | { |
1895 | { |
1906 | /* ampersand-form of call, use @_ instead of stack */ |
1896 | /* ampersand-form of call, use @_ instead of stack */ |
1907 | AV *av = GvAV (PL_defgv); |
1897 | AV *av = GvAV (PL_defgv); |
1908 | arg = AvARRAY (av); |
1898 | arg = AvARRAY (av); |
… | |
… | |
1912 | PUTBACK; |
1902 | PUTBACK; |
1913 | |
1903 | |
1914 | /* now call the init function, which needs to set up slf_frame */ |
1904 | /* now call the init function, which needs to set up slf_frame */ |
1915 | ((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr) |
1905 | ((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr) |
1916 | (aTHX_ &slf_frame, GvCV (gv), arg, items); |
1906 | (aTHX_ &slf_frame, GvCV (gv), arg, items); |
|
|
1907 | |
|
|
1908 | /* pop args */ |
|
|
1909 | SP = PL_stack_base + POPMARK; |
|
|
1910 | |
|
|
1911 | PUTBACK; |
1917 | } |
1912 | } |
1918 | |
1913 | |
1919 | /* now that we have a slf_frame, interpret it! */ |
1914 | /* now that we have a slf_frame, interpret it! */ |
1920 | /* we use a callback system not to make the code needlessly */ |
1915 | /* we use a callback system not to make the code needlessly */ |
1921 | /* complicated, but so we can run multiple perl coros from one cctx */ |
1916 | /* complicated, but so we can run multiple perl coros from one cctx */ |
… | |
… | |
1946 | |
1941 | |
1947 | SP = bot + 1; |
1942 | SP = bot + 1; |
1948 | } |
1943 | } |
1949 | |
1944 | |
1950 | PUTBACK; |
1945 | PUTBACK; |
|
|
1946 | } |
|
|
1947 | |
|
|
1948 | { |
|
|
1949 | struct coro *coro = SvSTATE_current; |
|
|
1950 | |
|
|
1951 | if (expect_false (coro->throw)) |
|
|
1952 | { |
|
|
1953 | SV *exception = sv_2mortal (coro->throw); |
|
|
1954 | |
|
|
1955 | coro->throw = 0; |
|
|
1956 | sv_setsv (ERRSV, exception); |
|
|
1957 | croak (0); |
|
|
1958 | } |
1951 | } |
1959 | } |
1952 | |
1960 | |
1953 | return NORMAL; |
1961 | return NORMAL; |
1954 | } |
1962 | } |
1955 | |
1963 | |