view release on metacpan or  search on metacpan

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

%include <smop/p5.h>
%attr PerlInterpreter* interpreter
%RI.id p5 interpreter
%prefix smop_p5interpreter
%prototype SMOP__P5Interpreter
%idconst continuation
%idconst goto

%{
  EXTERN_C void xs_init (pTHX);
  
  EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
  
  EXTERN_C void
  xs_init(pTHX)
  {
  	char *file = __FILE__;
  	dXSUB_SYS;
  
  	/* DynaLoader is a special case */
  	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
  }

  SMOP__Object* SMOP__P5__smop_interpreter;
  SMOP__Object* SMOP__P5__smop_p5interpreter;

  PerlInterpreter* SMOP__P5__p5interpreter_unbox(SMOP__Object* interpreter,SMOP__Object* p5interpreter) {
   assert(p5interpreter->RI == (SMOP__ResponderInterface*)RI);
   return ((smop_p5interpreter_struct*)p5interpreter)->interpreter; 
  }

%}

%method eval

  PerlInterpreter* my_perl = ((smop_p5interpreter_struct*)invocant)->interpreter;
  SMOP__P5__smop_interpreter = interpreter;
  SMOP__P5__smop_p5interpreter = invocant;
  SMOP__Object* obj = SMOP__NATIVE__capture_positional(interpreter,capture,1);

  if (SMOP_RI(obj) == SMOP_RI(SMOP__ID__new)) {
    int len;
    char* str = SMOP__NATIVE__idconst_fetch_with_null(obj,&len);

    dSP;

    ENTER;
    SAVETMPS;
    PUSHMARK(SP);    
    XPUSHs(sv_2mortal(newSVpvn(str,len)));
    PUTBACK;

    int count = call_pv("SMOP::coro_from_eval",G_SCALAR);
    if (count != 1) croak("Big trouble");

    SPAGAIN;
 

    SV* on_stack = POPs;
    SV* coro_sv = newSVsv(on_stack);
    assert(coro_sv);
    
    PUTBACK;
    FREETMPS;
    LEAVE;

    SMOP__Object* coro = SMOP__P5__Coro_create(interpreter,SMOP_REFERENCE(interpreter,invocant),coro_sv);

    SMOP__Object* frame = SMOP__Yeast__Frame_create(interpreter,SMOP_REFERENCE(interpreter,mold_run_coro));

    SMOP__Object* continuation = SMOP_DISPATCH(interpreter, SMOP_RI(interpreter),
      SMOP__ID__continuation,
      SMOP__NATIVE__capture_create(interpreter,
        (SMOP__Object*[]) {SMOP_REFERENCE(interpreter,interpreter),NULL},
        (SMOP__Object*[]) {NULL}));
    free(str);
    yeast_reg_set(interpreter,frame,0,SMOP_REFERENCE(interpreter,interpreter));
    yeast_reg_set(interpreter,frame,1,coro);
    yeast_reg_set(interpreter,frame,2,continuation);

    SMOP_DISPATCH(interpreter, SMOP_RI(interpreter), SMOP__ID__goto,SMOP__NATIVE__capture_create(interpreter,(SMOP__Object*[]) {SMOP_REFERENCE(interpreter,interpreter), frame, NULL}, (SMOP__Object*[]) {NULL}));

  } else {
    printf("only constant identifiers can be passed to eval (got %s)\n",obj->RI->id);
  }
  SMOP_RELEASE(interpreter,obj);

%method DESTROYALL
  PerlInterpreter* my_perl = ((smop_p5interpreter_struct*)invocant)->interpreter;
  perl_destruct(my_perl);
  perl_free(my_perl);
  PERL_SYS_TERM();

%method FETCH
  ___VALUE_FETCH___

%method STORE
  ___VALUE_STORE___

%method true
    ret = SMOP__NATIVE__bool_true;

%method new

  ret =  smop_nagc_alloc(sizeof(smop_p5interpreter_struct));
  ret->RI = (SMOP__ResponderInterface*)RI;
  PERL_SYS_INIT3(0,NULL,NULL);
  PerlInterpreter* my_perl = perl_alloc();
  PERL_SET_CONTEXT(my_perl);
  perl_construct(my_perl);
  char *embedding[] = { "", "-e", "0" };
  perl_parse(my_perl, xs_init, 3, embedding, NULL);
  PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
  //perl_run(my_perl);
  eval_pv("use SMOP::Interoperability",TRUE);
  ((smop_p5interpreter_struct*)ret)->interpreter = my_perl;

%yeast mold_run_coro
  my $interpreter;
  my $coro;
  my $back;
  my $void = $coro."set_back"($back);
  my $void = $interpreter."goto"($coro);

%init {
  smop_s1p_lexical_prelude_insert(interpreter,"P5Interpreter",SMOP_REFERENCE(interpreter,SMOP__P5Interpreter));
%}