Skip to content

Instantly share code, notes, and snippets.

@run4flat
Created January 24, 2012 03:44
Show Gist options
  • Save run4flat/1667669 to your computer and use it in GitHub Desktop.
Save run4flat/1667669 to your computer and use it in GitHub Desktop.
PDL+TCC
use strict;
use warnings;
use PDL;
use Inline Pdlpp => Config =>
INC => "-I$ENV{HOME}/include",
LIBS => "-L$ENV{HOME}/lib -ltcc",
;
use Inline 'Pdlpp';
######### The functions to check #########
my ($pdl_a, $pdl_b);
sub pdl_radius {
return sqrt($pdl_a**2 + $pdl_b**2);
}
sub tcc_radius {
return $pdl_a->custom_binop($pdl_b, 'sqrt(a*a + b*b)');
}
$pdl_b = $pdl_a = sequence(10);
print "pdl_radius gives ", pdl_radius(), "\n";
print "tcc_radius gives ", tcc_radius(), "\n";
######### Benchmarking code #########
use Time::HiRes qw(gettimeofday tv_interval);
my @Lengths = map {($_, 2*$_, 5*$_)} map {10**$_} qw(2 3 4 5 6 7);
for (@Lengths) {
print "$_ elements...\n";
$pdl_a = random($_);
$pdl_b = random($_);
my $t0 = [gettimeofday];
pdl_radius();
my $t1 = [gettimeofday];
print " PDL : ", tv_interval($t0 => $t1), "\n";
$t0 = [gettimeofday];
tcc_radius();
$t1 = [gettimeofday];
print " TCC : ", tv_interval($t0 => $t1), "\n";
}
#my $a = ones(10)->float + 2;
#my $b = $a->sequence;
#my $op = 'sqrt(a*a + b*b)';
#my $c = $a->custom_binop($b, $op);
#
#print "a is $a\nb is $b\n";
#print "$op is $c\n";
__END__
__Pdlpp__
# I need to define a few functions and declare a few package-globals:
pp_addpm(<<'MODULE_MATERIAL');
END {
_cleanup;
}
MODULE_MATERIAL
pp_addxs(<<'XS_MATERIAL');
void
_cleanup()
CODE:
# line 39 "eval-it.pl"
/* Cleanup the compiler states */
HV * states_hash = get_hv("PDL::TCC::compiler_states", 0);
if (states_hash != NULL) {
char * key;
HE * hash_entry;
SV ** value_p;
int n_keys = hv_iterinit(states_hash);
int i;
TCCState * s;
for(i = 0; i < n_keys; ++i) {
/* Get the hash entry */
hash_entry = hv_iternext(states_hash);
/* Get the key of the hash entry */
key = hv_iterkey(hash_entry, 0);
/* Free the TCC State object at the associated address */
/* note: tried to use hv_fetchs, but ran into compile issues */
value_p = hv_fetch(states_hash, key, strlen(key), 0);
s = INT2PTR(TCCState *, SvIV(*value_p));
tcc_delete(s);
}
}
XS_MATERIAL
pp_addhdr(<<'HEADER');
/* libtcc, of course */
#include <libtcc.h>
double foo(double a, double b) {
return sqrt(a*a + b*b);
}
HEADER
pp_def('custom_binop',
Pars => 'a(); b(); [o] c()',
OtherPars => 'char * string_to_eval',
Code => q{
# line 79 "eval-it.pl"
/* First check if the cash has a compiler state associated with this
* code fragment */
HV * states_hash = get_hv("PDL::TCC::compiler_states", GV_ADD);
TCCState * s;
char * key = $COMP(string_to_eval);
if (! hv_exists(states_hash, key, strlen(key))) {
char * to_compile = form("double sqrt(double); double foo(double, double); double to_eval (double a, double b) { return (%s);}", key);
/* Doesn't exist, so create the state and compile the function */
s = tcc_new();
if (s == NULL) croak("Unable to create tcc compiler context");
if (tcc_compile_string(s, to_compile) < 0)
croak("Unable to compile your string");
/* Add the sqrt symbol */
/* tcc_add_symbol(s, "sqrt", sqrt); */
/* tcc_add_symbol(s, "foo", foo); */
if (tcc_relocate(s) < 0)
croak("Unable to relocate compiled code");
/* Add the state to the hash */
hv_store(states_hash, key, strlen(key), newSViv((I32)s), 0);
}
else {
s = INT2PTR(TCCState *, SvIV(*(hv_fetch(states_hash, key, strlen(key), 0))));
}
double (*to_eval)(double, double) = tcc_get_symbol(s, "to_eval");
threadloop %{
$c() = to_eval($a(), $b());
%}
}
);
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment