#!/usr/bin/perl
package perlicious;

use strict;
use warnings;

use Data::Dumper;
use Inline C => 'DATA', CCFLAGS => '-g', CLEAN_AFTER_BUILD => 0;

sub debug { print Dumper([@_]), "\n" }

print ">>>Calling in...<<<\n";
in("smack", 16, "that", "fool");
print "\n>>>Calling out...<<<\n";
debug out("smack", 16, "that", "fool");
print ">>>Calling combo...<<<\n";
debug buggy("smack", 16, "that", "fool");

# This just returns a list of numbers
sub perlish {
  my $num = shift;
  my @ls;
  push @ls, "numba $_" foreach 1 .. $num;
  return @ls;
}

__DATA__
__C__

// All of this probably could be written better. I'm new to C and XS. Critique
// welcome.

// This tests taking in a variable amount of arguments. Works fine.
void in (char *first, ...) {
  SV *gotin[10];
  int passed;
  dXSARGS;
  sp = mark;
  passed = items;
  int i;
  for (i = 0; i < items; i++) {
    gotin[i] = newSVsv( ST(i) );
  }
  PUTBACK;
  int cntr;
  for (cntr = 0; cntr < passed; cntr++) {
    printf("gotin: %s\n", SvPV_nolen( gotin[cntr] ));
  }
}

// This demonstrates calling a perl sub and returning its results to perl. The
// reason for the separate blocks is to avoid clashes with the macros that set
// up the stack variables. This is also why the temporary array gotback is
// needed.
void out (SV* useless, ...) {
  SV *gotback[10];
  int returned;
  if (1) {
    dSP;
    I32 ax;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    XPUSHs( sv_2mortal( newSViv(7) ) );
    PUTBACK;
    returned = call_pv("perlish", G_ARRAY);
    printf("expect %d args\n", returned);
    SPAGAIN;
    SP -= returned;
    ax = (SP - PL_stack_base) + 1;
    int cnt;
    // Somehow store the return values. We need an array of SV*s.
    for (cnt = 0; cnt < returned; cnt++) {
      gotback[cnt] = newSVsv( ST(cnt) );
    }
    PUTBACK;
    FREETMPS;
    LEAVE;
  }
  // Finally push the crap onto our return stack.
  if (1) {
    dXSARGS;
    sp = mark;
    int cnt;
    for (cnt = 0; cnt < returned; cnt++) {
      XPUSHs( gotback[cnt] );
    }
    PUTBACK;
    return;
  }
}

// This tries to combine the two by taking a variable amount of arguments in
// and returning a variable amount to perl. The input bit works, but the output
// does not. (perl doesn't get any return values back on the stack.) This is
// undoubtedly due to the fact that I use the dXSARGS, sp=mark, etc setup bit
// twice. I don't know how to get around this. Help?

// The solution may lie in the SPAGAIN, ENTER, LEAVE, etc macros which some of
// the documentation mentions. I'll get around to experimenting with those
// later. In the meantime, does anybody know exactly what to do?
void buggy (char *first, ...) {
  // Tough to get around. Max arguments we can get back from a perl function
  // is gonna be 10. sorry.
  // Same for max we can take in here.
  SV *gotin[10];
  SV *gotback[10];
  int returned, passed;
  // First print args. Make sure I've got em!
  if (1) {
    dXSARGS;
    sp = mark;
    passed = items;
    int i;
    for (i = 0; i < items; i++) {
      gotin[i] = newSVsv( ST(i) );
    }
    PUTBACK;
    int cntr;
    for (cntr = 0; cntr < passed; cntr++) {
      printf("gotin: %s\n", SvPV_nolen( gotin[cntr] ));
    }
  }
  if (1) {
    dSP;
    I32 ax;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    XPUSHs( sv_2mortal( newSViv(7) ) );
    PUTBACK;
    returned = call_pv("perlish", G_ARRAY);
    printf("expect %d args\n", returned);
    SPAGAIN;
    SP -= returned;
    ax = (SP - PL_stack_base) + 1;
    int cnt;
    // Somehow store the return values. We need an array of SV*s.
    for (cnt = 0; cnt < returned; cnt++) {
      gotback[cnt] = newSVsv( ST(cnt) );
    }
    PUTBACK;
    FREETMPS;
    LEAVE;
  }
  // Finally push the crap onto our return stack.
  if (1) {
    dXSARGS;
    sp = mark;
    int cnt;
    for (cnt = 0; cnt < returned; cnt++) {
      XPUSHs( gotback[cnt] );
    }
    PUTBACK;
    return;
  }
}