… | |
… | |
722 | |
722 | |
723 | INLINE void |
723 | INLINE void |
724 | set_stacklevel_tail (pTHX) |
724 | set_stacklevel_tail (pTHX) |
725 | { |
725 | { |
726 | dSP; |
726 | dSP; |
|
|
727 | SV **bot = SP; |
|
|
728 | |
727 | int gimme = GIMME_V; |
729 | int gimme = GIMME_V; |
728 | |
730 | |
|
|
731 | /* make sure we put something on the stack in scalar context */ |
729 | if (gimme == G_SCALAR) |
732 | if (gimme == G_SCALAR) |
|
|
733 | { |
|
|
734 | if (sp == bot) |
730 | XPUSHs (&PL_sv_undef); |
735 | XPUSHs (&PL_sv_undef); |
|
|
736 | |
|
|
737 | SP = bot + 1; |
|
|
738 | } |
731 | |
739 | |
732 | PUTBACK; |
740 | PUTBACK; |
733 | } |
741 | } |
734 | |
742 | |
735 | /** coroutine stack handling ************************************************/ |
743 | /** coroutine stack handling ************************************************/ |
… | |
… | |
1851 | } |
1859 | } |
1852 | |
1860 | |
1853 | /* declare prototype */ |
1861 | /* declare prototype */ |
1854 | XS(XS_Coro__State__set_stacklevel); |
1862 | XS(XS_Coro__State__set_stacklevel); |
1855 | |
1863 | |
|
|
1864 | #define OPpENTERSUB_SSL 15 |
|
|
1865 | |
1856 | static OP * |
1866 | static OP * |
1857 | pp_set_stacklevel (pTHX) |
1867 | pp_set_stacklevel (pTHX) |
1858 | { |
1868 | { |
1859 | dSP; |
1869 | dSP; |
1860 | struct transfer_args ta; |
1870 | struct transfer_args ta; |
… | |
… | |
1876 | arg = AvARRAY (av); |
1886 | arg = AvARRAY (av); |
1877 | items = AvFILLp (av) + 1; |
1887 | items = AvFILLp (av) + 1; |
1878 | } |
1888 | } |
1879 | |
1889 | |
1880 | PUTBACK; |
1890 | PUTBACK; |
1881 | switch (PL_op->op_private & 7) |
1891 | switch (PL_op->op_private & OPpENTERSUB_SSL) |
1882 | { |
1892 | { |
1883 | case 0: |
1893 | case 0: |
1884 | prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0])); |
1894 | prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0])); |
1885 | break; |
1895 | break; |
1886 | |
1896 | |
… | |
… | |
1932 | Coro::cede_notself = 4 |
1942 | Coro::cede_notself = 4 |
1933 | CODE: |
1943 | CODE: |
1934 | { |
1944 | { |
1935 | assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel)); |
1945 | assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel)); |
1936 | |
1946 | |
|
|
1947 | assert (("FATAL: ssl call with illegal CV value", CvGV (cv))); |
|
|
1948 | ssl_cv = cv; |
|
|
1949 | |
1937 | /* we patch the op, and then re-run the whole call */ |
1950 | /* we patch the op, and then re-run the whole call */ |
1938 | /* we have to put some dummy argument on the stack for this to work */ |
1951 | /* we have to put some dummy argument on the stack for this to work */ |
1939 | /* TODO: walk back the opcode chain (but how?), nuke the pp_gv etc. */ |
|
|
1940 | ssl_restore.op_next = (OP *)&ssl_restore; |
1952 | ssl_restore.op_next = (OP *)&ssl_restore; |
1941 | ssl_restore.op_type = OP_NULL; |
1953 | ssl_restore.op_type = OP_NULL; |
1942 | ssl_restore.op_ppaddr = pp_restore; |
1954 | ssl_restore.op_ppaddr = pp_restore; |
1943 | ssl_restore.op_first = PL_op; |
1955 | ssl_restore.op_first = PL_op; |
1944 | |
1956 | |
1945 | ssl_arg0 = items > 0 ? SvREFCNT_inc (ST (0)) : 0; |
1957 | ssl_arg0 = items > 0 ? SvREFCNT_inc (ST (0)) : 0; |
1946 | ssl_arg1 = items > 1 ? SvREFCNT_inc (ST (1)) : 0; |
1958 | ssl_arg1 = items > 1 ? SvREFCNT_inc (ST (1)) : 0; |
1947 | |
1959 | |
1948 | PL_op->op_ppaddr = pp_set_stacklevel; |
1960 | PL_op->op_ppaddr = pp_set_stacklevel; |
1949 | PL_op->op_private = PL_op->op_private & ~7 | ix; /* we potentially share our private flags with entersub */ |
1961 | PL_op->op_private = PL_op->op_private & ~OPpENTERSUB_SSL | ix; /* we potentially share our private flags with entersub */ |
1950 | |
1962 | |
1951 | PL_op = (OP *)&ssl_restore; |
1963 | PL_op = (OP *)&ssl_restore; |
1952 | } |
1964 | } |
1953 | |
1965 | |
1954 | BOOT: |
1966 | BOOT: |
… | |
… | |
1958 | # if CORO_PTHREAD |
1970 | # if CORO_PTHREAD |
1959 | coro_thx = PERL_GET_CONTEXT; |
1971 | coro_thx = PERL_GET_CONTEXT; |
1960 | # endif |
1972 | # endif |
1961 | #endif |
1973 | #endif |
1962 | BOOT_PAGESIZE; |
1974 | BOOT_PAGESIZE; |
1963 | |
|
|
1964 | ssl_cv = get_cv ("Coro::State::_set_stacklevel", 0); |
|
|
1965 | |
1975 | |
1966 | irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV); |
1976 | irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV); |
1967 | stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); |
1977 | stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); |
1968 | |
1978 | |
1969 | orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get; |
1979 | orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get; |