SMOP

 view release on metacpan or  search on metacpan

Interoperability.xs  view on Meta::CPAN

          SMOP_REFERENCE(interpreter,SMOP__P5__current_back),
          wrapped_sv,
          NULL
        },
        (SMOP__Object*[]) { NULL }
    ));

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


    SMOP__P5__transfer_to_main_coro(aTHX_ interpreter);

MODULE = SMOP::Interoperability       PACKAGE = SMOP::Object

SV*
AUTOLOAD(SV* self, ...)
  CODE:
    SV* value = SvRV(self);
    SMOP__Object* object = (SMOP__Object*)SvIV(value);    

    int len = SvCUR(cv);
    char* identifier = SvPVX(cv);

    SMOP__Object* interpreter = SMOP__P5__smop_interpreter;

    SMOP__Object* ret = SMOP_DISPATCH(interpreter,SMOP_RI(object),SMOP__NATIVE__idconst_createn(identifier,len),SMOP__NATIVE__capture_create(interpreter,(SMOP__Object*[]) {SMOP_REFERENCE(interpreter,object),NULL},(SMOP__Object*[]) {NULL}));


    RETVAL = SMOP__Object2SV(interpreter,aTHX_ ret);
    SMOP__P5__result_sv = RETVAL;

    SMOP__P5__transfer_to_main_coro(aTHX_ interpreter);

  OUTPUT:
    RETVAL
 

void DESTROY(SV* self)
  CODE:
    SV* value = SvRV(self);
    SMOP__Object* object = (SMOP__Object*)SvIV(value);    
    SMOP__Object* interpreter = SMOP__P5__smop_interpreter;
    SMOP_RELEASE(interpreter,object);
    SMOP__P5__transfer_to_main_coro(aTHX_ interpreter);


MODULE = SMOP::Interoperability       PACKAGE = SMOP::NATIVE::bool

SV*
true(...)
  CODE:
    SV* pointer = newSViv(PTR2IV(SMOP__NATIVE__bool_true));
    SV* object = newRV_noinc(pointer);
    HV* class = gv_stashpv("SMOP::Object", 0);

MANIFEST  view on Meta::CPAN

nagc/src/weakref.h
nagc/t/create_and_destroy.c
native/include/smop/native.h
native/src/bool_message.ri
native/src/capture_message.ri
native/src/idconst_message.ri
native/src/native.c
native/src/native_int.ri
native/t/int.c
p5/include/smop/p5.h
p5/src/coro.ri
p5/src/p5.c
p5/src/p5interpreter.ri
p5/src/sv.ri
p6opaque/include/smop/p6opaque.h
p6opaque/src/p6opaque.ri
p6opaque/src/p6opaque_default_how.ri
p6opaque/src/p6opaque_proto_storage.ri
profile/include/smop/profile.h
profile/src/profile.c
s0native/include/smop/s0native.h

lib/SMOP/Interoperability.pm  view on Meta::CPAN

package SMOP;
BEGIN {
  $SMOP::VERSION = '0.6';
}

use 5.010000;
use strict;
use warnings;
use Carp;
use Coro;
our $main_coro = new Coro::State;


require XSLoader;
XSLoader::load('SMOP::Interoperability');

sub coro_from_eval {
    my $code = shift;
    Coro::State->new(sub {
       my $ret = eval $code;
       die if $@;
       SMOP::Interoperability::goto_back($ret);
    });
}
sub coro_from_methodcall {
    my $invocant = shift;
    my $method = shift;
    my $args = \@_;
    Coro::State->new(sub {
        my $ret = $invocant->$method(@$args);
        SMOP::Interoperability::goto_back($ret);
    });
}
sub coro_from_subcall {
    my $sub = shift;
    my $args = \@_;
    Coro::State->new(sub {
        my $ret = $sub->(@$args);
        SMOP::Interoperability::goto_back($ret);
    });
}

package SMOP::Object;
BEGIN {

p5/include/smop/p5.h  view on Meta::CPAN

#ifndef SMOP_P5_H
#include <smop/base.h>
#include <EXTERN.h>
#include <perl.h>
#define SMOP_P5_H
extern SMOP__Object* SMOP__P5Interpreter;

extern SMOP__Object* SMOP__P5__smop_interpreter;
extern SV* SMOP__P5__current_coro_state;
extern SMOP__Object* SMOP__P5__current_back;
extern SMOP__Object* SMOP__P5__smop_p5interpreter;
extern SV* SMOP__P5__result_sv;
extern int* SMOP__P5__current_coro_has_next;

SMOP__Object* SMOP__P5__SV_create(SMOP__Object* interpreter,SMOP__Object* p5interpreter,SV* sv);
PerlInterpreter* SMOP__P5__p5interpreter_unbox(SMOP__Object* interpreter,SMOP__Object* p5interpreter);
SMOP__Object* SMOP__P5__Coro_create(SMOP__Object* interpreter,SMOP__Object* p5interpreter,SV* coro);
SV* SMOP__Object2SV(SMOP__Object* interpreter,pTHX_ SMOP__Object* object);
void SMOP__P5__transfer_to_main_coro(pTHX_ SMOP__Object* interpreter);

void smop_p5interpreter_init(SMOP__Object* interpreter);
void smop_p5interpreter_destr(SMOP__Object* interpreter);

void smop_p5_sv_init(SMOP__Object* interpreter);
void smop_p5_sv_destr(SMOP__Object* interpreter);

void smop_p5_coro_init(SMOP__Object* interpreter);
void smop_p5_coro_destr(SMOP__Object* interpreter);

void smop_p5_init(SMOP__Object* interpreter);
void smop_p5_destr(SMOP__Object* interpreter);
#endif

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);
  }

p5/src/p5.c  view on Meta::CPAN

#include <smop/base.h>
#include <smop/s0native.h>
#include <smop/p5.h>
#include <stdio.h>
void smop_p5_init(SMOP__Object* interpreter) {
  smop_p5interpreter_init(interpreter);
  smop_p5_sv_init(interpreter);
  smop_p5_coro_init(interpreter);
}
void smop_p5_destr(SMOP__Object* interpreter) {
  smop_p5_coro_destr(interpreter);
  smop_p5_sv_destr(interpreter);
  smop_p5interpreter_destr(interpreter);
}

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

    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

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

  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));
%}

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

    ret->RI = (SMOP__ResponderInterface*) RI;
    ((smop_p5_sv_struct*)ret)->sv = SvREFCNT_inc(sv);
    ((smop_p5_sv_struct*)ret)->p5interpreter = p5interpreter;
    return ret;
  }

  I32 magic_STORE(pTHX_ IV obj_address,SV* sv) {
    SMOP__Object* object = (SMOP__Object*) obj_address;
    SMOP__Object* interpreter = SMOP__P5__smop_interpreter;
    SMOP__P5__result_sv = NULL;
    SMOP__P5__transfer_to_main_coro(aTHX_ interpreter);

    SMOP__Object* rvalue = SV2SMOP__Object(interpreter,SMOP_REFERENCE(interpreter,SMOP__P5__smop_p5interpreter),sv);


    SMOP__Object* ret = SMOP_DISPATCH(interpreter,SMOP_RI(object),SMOP__ID__STORE,SMOP__NATIVE__capture_create(interpreter,(SMOP__Object*[]) {SMOP_REFERENCE(interpreter,object),rvalue,NULL},(SMOP__Object*[]) {NULL}));
    SMOP_RELEASE(interpreter,ret);
    return 0;
  }
  I32 magic_FETCH(pTHX_ IV obj_address,SV* sv) {

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

    SMOP__Object* ret = SMOP_DISPATCH(interpreter,SMOP_RI(object),SMOP__ID__FETCH,SMOP__NATIVE__capture_create(interpreter,(SMOP__Object*[]) {SMOP_REFERENCE(interpreter,object),NULL},(SMOP__Object*[]) {NULL}));

    SV* ret_sv = SMOP__Object2SV(interpreter,aTHX_ ret);

    /*if (ret->RI == RI) {
        SvSetSV_nosteal(sv,ret_sv);
    } else {
    }*/
    sv_setsv_flags(sv,ret_sv, SV_NOSTEAL);
    SMOP__P5__transfer_to_main_coro(aTHX_ interpreter);
    return 0;
  }
  SV* SMOP__Object2SV(SMOP__Object* interpreter,pTHX_ SMOP__Object* object) {
    if (object->RI == (SMOP__ResponderInterface*)RI) {
      SV* ret = ((smop_p5_sv_struct*)object)->sv;
      SMOP_RELEASE(interpreter,object);
      return SvREFCNT_inc(ret);
    } else {
      SV* pointer = newSViv(PTR2IV(object));
      HV* class = gv_stashpv("SMOP::Object", GV_ADD);

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

    int positionals = SMOP__NATIVE__capture_positional_count(interpreter,capture);
    int i;
    for (i=1;i < positionals;i++) {
      SMOP__Object* object = SMOP__NATIVE__capture_positional(interpreter,capture,i);
      XPUSHs(SMOP__Object2SV(interpreter,aTHX_ object));
    }

    PUTBACK;

    int count = call_pv("SMOP::coro_from_methodcall",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,SMOP__P5__smop_p5interpreter),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}));

    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}));

    free(method);
  }
  if (invocant) SMOP_RELEASE(interpreter,invocant);
  SMOP_RELEASE(interpreter,capture);
  return ret;
%}
%method FETCH

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

  int i;
  for (i=0;i < positionals;i++) {
    SMOP__Object* object = SMOP__NATIVE__capture_positional(interpreter,real_capture,i);
    XPUSHs(SMOP__Object2SV(interpreter,aTHX_ object));
  }

  SMOP_RELEASE(interpreter,real_capture);

  PUTBACK;

  int count = call_pv("SMOP::coro_from_subcall",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,SMOP__P5__smop_p5interpreter),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}));

  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}));

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