view release on metacpan or  search on metacpan

p5/src/coro.ri  view on Meta::CPAN

%include <smop/p5.h>
%prefix smop_p5_coro
%attr SV* coro
%attr SMOP__Object* p5interpreter
%attr SMOP__Object* back;
%RI.id p5 coro

%{
SV* SMOP__P5__current_coro_state;
SMOP__Object* SMOP__P5__current_back;
SV* SMOP__P5__result_sv;

SMOP__Object* SMOP__P5__Coro_create(SMOP__Object* interpreter,SMOP__Object* p5interpreter,SV* coro) {
    smop_p5_coro_struct* ret = (smop_p5_coro_struct*) smop_nagc_alloc(sizeof(smop_p5_coro_struct));
    ret->coro = coro;
    ret->p5interpreter = p5interpreter;
    assert(RI);
    ret->RI = (SMOP__ResponderInterface*) RI;
    return (SMOP__Object*) ret;
}

void SMOP__P5__transfer_to_main_coro(pTHX_ SMOP__Object* interpreter) {


  SV* current = SMOP__P5__current_coro_state;
  SV* maincoro = get_sv("SMOP::main_coro",FALSE);
  assert(maincoro);
  assert(current);
  dSP;
  ENTER;
  SAVETMPS;

  PUSHMARK(SP);
  XPUSHs(current);
  XPUSHs(maincoro);
  PUTBACK;
  call_method("transfer",G_DISCARD);

  FREETMPS;
  LEAVE;
}
%}

%method eval

  //smop_lowlevel_rdlock(invocant);
  SMOP__Object* p5interpreter = ((smop_p5_coro_struct*)invocant)->p5interpreter;
  SV* coro = ((smop_p5_coro_struct*)invocant)->coro;
  SMOP__Object* back = ((smop_p5_coro_struct*)invocant)->back;
  //smop_lowlevel_unlock(invocant);

  PerlInterpreter* my_perl = SMOP__P5__p5interpreter_unbox(interpreter,p5interpreter);

  SMOP__P5__current_coro_state = coro;
  SMOP__P5__current_back = back;


  SV* main_coro = get_sv("SMOP::main_coro",FALSE);
  assert(main_coro);
  assert(coro);
  dSP;
  ENTER;
  SAVETMPS;

  PUSHMARK(SP);
  XPUSHs(main_coro);
  XPUSHs(coro);
  PUTBACK;
  call_method("transfer",G_DISCARD);

  FREETMPS;
  LEAVE;

  ret = SMOP__NATIVE__bool_true;

%method finished

%method DESTROYALL

  SMOP__Object* back = ((smop_p5_coro_struct*)invocant)->back;
  SV* coro = ((smop_p5_coro_struct*)invocant)->coro;
  SMOP__Object* p5interpreter = ((smop_p5_coro_struct*)invocant)->p5interpreter;
  PerlInterpreter* my_perl = SMOP__P5__p5interpreter_unbox(interpreter,p5interpreter);

  dSP;
  ENTER;
  SAVETMPS;

  PUSHMARK(SP);
  XPUSHs(coro);
  PUTBACK;
  call_method("cancel",G_DISCARD);

  FREETMPS;
  LEAVE;


  SvREFCNT_dec(coro);

  if (back) SMOP_RELEASE(interpreter,back);
  SMOP_RELEASE(interpreter,p5interpreter);

%method back
  if (((smop_p5_coro_struct*)invocant)->back) {
    ret = SMOP_REFERENCE(interpreter,((smop_p5_coro_struct*)invocant)->back);
  }
%method set_back
  SMOP__Object* value = SMOP__NATIVE__capture_positional(interpreter, capture, 1);
  if (!((smop_p5_coro_struct*)invocant)->back) {
    ((smop_p5_coro_struct*)invocant)->back = value;
  } else {
    printf("trying to set a new back to the frame\n");
    abort();
  }
%method setr
  if (SMOP__P5__result_sv) {
    SMOP__Object* p5interpreter = ((smop_p5_coro_struct*)invocant)->p5interpreter;
    PerlInterpreter* my_perl = SMOP__P5__p5interpreter_unbox(interpreter,p5interpreter);

    SMOP__Object* ret = SMOP__NATIVE__capture_positional(interpreter, capture, 1);


    SV* ret_sv = SMOP__Object2SV(interpreter,aTHX_ ret);
    sv_setsv_flags(SMOP__P5__result_sv,ret_sv, SV_NOSTEAL);
  }