Anno said:
What brought you to that conclusion? It's wrong. The overload routine
must *return* an object, it doesn't have to create it. It is perfectly
free to return its first argument with or without prior modification.
That's what I needed to know.
If I want to return the "first argument with or without prior
modification" then the overload routine needs to increase the first
arg's reference count - otherwise 'DESTROY($obj)' gets called. That's
where I was stuffing up. Your definitive reply quickly led me to that
realisation. (Actually I don't know that the reference count *needs* to
be increased - but it's certainly one way of efficiently fixing the
problem I was experiencing.)
The overload routines are Inline C routines, and they use functions in
the GMP library - and I doubted there was much use in posting any code.
Perhaps I was wrong about that .... or perhaps not. The current script
I'm using to test things out is reproduced below and seems to me to be
working nicely - in so far as it goes
Thanks Anno.
Cheers,
Rob
package overloaded;
use warnings;
use Benchmark;
use overload
'*' => \&overload_mul,
'+' => \&overload_add,
'*=' => \&overload_mul_eq;
use Inline (C => Config =>
LIBS => '-lgmp',
BUILD_NOISY => 1,
);
use Inline C => <<'EOC';
#include <stdio.h>
#include <stdlib.h>
#include <gmp.h>
SV * Rmpz_init_set_str(SV * num, SV * base) {
mpz_t * mpz_t_obj;
unsigned long b = SvUV(base);
if(b == 1 || b > 36) croak("Second argument supplied to
Rmpz_init_set_str() is not in acceptable range");
New(1, mpz_t_obj, sizeof(mpz_t), mpz_t);
if(mpz_t_obj == NULL) croak("Failed to allocate memory in
Rmpz_init_set_str function");
if(mpz_init_set_str (*mpz_t_obj, SvPV_nolen(num), b))
croak("First argument supplied to Rmpz_init_set_str() is not a
valid base %u number", b);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
SV * overload_mul(SV * a, SV * b, SV * third) {
mpz_t * mpz_t_obj, t;
New(1, mpz_t_obj, sizeof(mpz_t), mpz_t);
if(mpz_t_obj == NULL) croak("Failed to allocate memory in
overload_mul function");
mpz_init(*mpz_t_obj);
if(SvUOK(b)) {
mpz_mul_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvUV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvIOK(b)) {
mpz_mul_si(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvIV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvNOK(b)) {
mpz_init_set_d(t, SvNV(b));
mpz_mul(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), t);
mpz_clear(t);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvROK(b)) {
mpz_mul(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(b))));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
croak("Invalid argument supplied to overload_mul");
}
SV * overload_mul_eq(SV * a, SV * b, SV * third) {
mpz_t t;
if(SvUOK(b)) {
SvREFCNT_inc(a);
mpz_mul_ui(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(a))), SvUV(b));
return a;
}
if(SvIOK(b)) {
SvREFCNT_inc(a);
mpz_mul_si(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(a))), SvIV(b));
return a;
}
if(SvNOK(b)) {
SvREFCNT_inc(a);
mpz_init_set_d(t, SvNV(b));
mpz_mul(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *) SvIV(SvRV(a))), t);
mpz_clear(t);
return a;
}
if(SvROK(b)) {
SvREFCNT_inc(a);
mpz_mul(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *) SvIV(SvRV(a))),
*((mpz_t *) SvIV(SvRV(b))));
return a;
}
croak("Invalid argument supplied to overload_mul_eq");
}
SV * overload_add(SV * a, SV * b, SV * third) {
mpz_t * mpz_t_obj, t;
New(1, mpz_t_obj, sizeof(mpz_t), mpz_t);
if(mpz_t_obj == NULL) croak("Failed to allocate memory in
overload_mul function");
mpz_init(*mpz_t_obj);
if(SvUOK(b)) {
mpz_add_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvUV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvIOK(b)) {
if(SvIV(b) >= 0) {
mpz_add_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvIV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
mpz_sub_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvIV(b) * -1);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvNOK(b)) {
mpz_init_set_d(t, SvNV(b));
mpz_add(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), t);
mpz_clear(t);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvROK(b)) {
mpz_add(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(b))));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
croak("Invalid argument supplied to overload_add function");
}
SV * Rmpz_get_str(SV * p, SV * base) {
char * out;
SV * outsv;
unsigned long b = SvUV(base);
if(b < 2 || b > 36) croak("Second argument supplied to
Rmpz_get_str() is not in acceptable range");
New(2, out, mpz_sizeinbase(*((mpz_t *) SvIV(SvRV(p))), b) + 5, char);
if(out == NULL) croak("Failed to allocate memory in Rmpz_deref
function");
mpz_get_str(out, b, *((mpz_t *) SvIV(SvRV(p))));
outsv = newSVpv(out, 0);
Safefree(out);
return outsv;
}
void DESTROY(SV * p) {
/* printf("Destroying mpz "); */
mpz_clear(*((mpz_t *) SvIV(SvRV(p))));
Safefree((mpz_t *) SvIV(SvRV(p)));
}
EOC
my $str = '12345';
my $x = Rmpz_init_set_str($str, 10);
my $y = Rmpz_init_set_str('7', 10);
my $z = 1 * $x * $y * (2 ** 43);
print Rmpz_get_str($z, 10), "\n";
$z = -9 + $z + $y + -7;
print Rmpz_get_str($z, 10), "\n";
$z = $z + 9;
print Rmpz_get_str($z, 10), "\n";
$z *= 11;
print Rmpz_get_str($z, 10), "\n";
$z *= 11;
print Rmpz_get_str($z, 10), "\n";
$z *= $y;
print Rmpz_get_str($z, 10), "\n";
timethese (1, {
'ovrld1' => '$z = factorial_1(50000);',
'ovrld2' => '$z = factorial_2(50000);',
});
sub factorial_1 {
my $n = $_[0];
my $ret = Rmpz_init_set_str('1', 16);
for(2 .. $n) {$ret = $ret * $_}
return $ret;
}
sub factorial_2 {
my $n = $_[0];
my $ret = Rmpz_init_set_str('1', 16);
for(2 .. $n) {$ret *= $_}
return $ret;
}