Anno Siegel wrote:

>

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

}

--

To reply by email u have to take out the u in kalinaubears.