XS-TCC

 view release on metacpan or  search on metacpan

TCC.xs  view on Meta::CPAN

    const char *CLASS = "XS::TCC::TCCSymbol";
    /* Note: Perl symbol objects must not live longer than TCCStates
     *       or they become invalid. */
  CODE:
    RETVAL = tcc_get_symbol(self->tccstate, name);
    if (RETVAL == NULL)
      croak("Symbol '%s' not found!", name);
  OUTPUT: RETVAL

int
relocate(xstcc_state *self)
  PREINIT:
    AV *outav;
    SV *memsv;
    size_t memsize;
  CODE:
    outav = get_av("XS::TCC::TCCState::_output_memory", GV_ADD);
    memsize = tcc_relocate(self->tccstate, NULL);
    memsv = newSV(memsize);
    av_push(outav, memsv);
    RETVAL = tcc_relocate(self->tccstate, SvPVX(memsv));
  OUTPUT: RETVAL

MODULE = XS::TCC        PACKAGE = XS::TCC::TCCSymbol

CV *
as_xsub(xstcc_symbol *self)
  PREINIT:
    XSUBADDR_t sub;
  CODE:
    sub = (XSUBADDR_t)self;

lib/XS/TCC.pm  view on Meta::CPAN

  # Add user-specified files
  my @add_files;
  @add_files = ref($args{add_files}) ? @{$args{add_files}} : $args{add_files}
    if defined $args{add_files};
  $compiler->add_file($_) for @add_files;

  # Do the compilation
  $compiler->set_options(($args{ccopts} // $CCOPTS));
  # compile_string() returns 0 if succeeded, -1 otherwise.
  my $fatal = $compiler->compile_string($final_code);
  $compiler->relocate();

  if (defined $errmsg) {
    $errmsg = _build_compile_error_msg($errmsg, 1);
    if ($fatal) {
      Carp::croak($errmsg);
    } else {
      Carp::carp($errmsg);
    }
  }

t/10_lowlevel.t  view on Meta::CPAN

  my $i = $comp->compile_string("");
  is($i, 0);

  is($comp->compile_string(<<'HERE'), 0, "Real code example compiles");
int
xs_tcc_test_foo(int a, int b)
{
  return a + b;
}
HERE
  is($comp->relocate(), 0);
  isa_ok($comp->get_symbol("xs_tcc_test_foo"), "XS::TCC::TCCSymbol");
}

SCOPE: {
  my $comp = make_comp();
  $comp->set_options($XS::TCC::CCOPTS);
  if ($^O eq 'darwin') {
    $comp->define_symbol("__XS_TCC_DARWIN__", 1);
  }

t/10_lowlevel.t  view on Meta::CPAN

  if (items != 2)
    croak("Need two params");

  rv = SvIV(ST(0)) + SvIV(ST(1));

  { XSprePUSH; PUSHi((IV)rv); }
  XSRETURN(1);
}
HERE

  is($comp->relocate(), 0);
  my $sym = $comp->get_symbol("xs_tcc_test_bar");
  isa_ok($sym, "XS::TCC::TCCSymbol");

  my $sub = $sym->as_xsub();

  ok(!eval {$sub->(); 1} && $@);
  is($sub->(3, 5), 8, "XSUB can add!");
}

pass("Alive");