Merge pull request #3132 from d-torrance/ffi-gmp

Restore previous memory allocation behavior of GMP integers in ForeignFunctions package
Macaulay2 · Feb 14, 2024 · 6a51eca · 6a51eca
2 parents f6289b2 + d1a1698
commit 6a51eca
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 11 deletions.
diff --git a/M2/Macaulay2/d/ffi.d b/M2/Macaulay2/d/ffi.d
@@ -216,7 +216,9 @@ ffiIntegerType(e:Expr):Expr := (
 	if length(a) == 2 then (
 	    when a.0
 	    is n:ZZcell do (
-		if isZero(n.v)
+		if !isInt(n)
+		then WrongArgSmallInteger(1)
+		else if isZero(n.v)
 		then toExpr(Ccode(voidPointer, "&ffi_type_pointer"))
 		else when a.1
 		is signed:Boolean do (
@@ -260,10 +262,15 @@ ffiIntegerAddress(e:Expr):Expr := (
 	    is x:ZZcell do (
 		when a.1
 		is y:ZZcell do (
-		    if isZero(y.v) then (
-			z := copy(x.v);
+		    if !isInt(y)
+		    then WrongArgSmallInteger(2)
+		    else if isZero(y.v) then (
+			z := newZZmutable();
+			set(z, x.v);
 			ptr := getMem(pointerSize);
-			Ccode(void, "*(mpz_srcptr *)", ptr, " = ", z);
+			Ccode(void, "*(mpz_ptr *)", ptr, " = ", z);
+			Ccode(void, "GC_REGISTER_FINALIZER(", ptr, ", ",
+			    "(GC_finalization_proc)mpz_clear, ", z, ", 0, 0)");
 			toExpr(ptr))
 		    else when a.2
 		    is signed:Boolean do (
@@ -320,7 +327,9 @@ ffiIntegerValue(e:Expr):Expr := (
 	    is x:pointerCell do (
 		when a.1
 		is y:ZZcell do (
-		    if isZero(y.v)
+		    if !isInt(y)
+		    then WrongArgSmallInteger(2)
+		    else if isZero(y.v)
 		    then toExpr(moveToZZ(Ccode(ZZmutable, "*(mpz_ptr*)", x.v)))
 		    else when a.2
 		    is signed:Boolean do (
@@ -363,6 +372,7 @@ setupfun("ffiIntegerValue", ffiIntegerValue);
 ffiRealType(e:Expr):Expr := (
     when e
     is n:ZZcell do (
+	if !isInt(n) then return WrongArgSmallInteger();
 	bits := toInt(n);
 	if bits == 0 then toExpr(Ccode(voidPointer, "&ffi_type_pointer"))
 	else if bits == 32 then toExpr(Ccode(voidPointer, "&ffi_type_float"))
@@ -383,11 +393,17 @@ ffiRealAddress(e:Expr):Expr := (
 	    is x:RRcell do (
 		when a.1
 		is y:ZZcell do (
+		    if !isInt(y) then return WrongArgSmallInteger();
 		    bits := toInt(y);
 		    if bits == 0 then (
-			z := copy(x.v);
+			z := newRRmutable(precision(x.v));
+			Ccode(void, "mpfr_set(", z, ", ", x.v, ", MPFR_RNDN)");
 			ptr := getMem(pointerSize);
-			Ccode(void, "*(mpfr_srcptr *)", ptr, " = ", z);
+			Ccode(void, "*(mpfr_ptr *)", ptr, " = ", z);
+			-- TODO: we get segfaults during garbage collection
+			-- if the following is uncommented
+			-- Ccode(void, "GC_REGISTER_FINALIZER(", ptr, ", ",
+			--  "(GC_finalization_proc)mpfr_clear, ", z, ", 0, 0)");
 			toExpr(ptr))
 		    else if bits == 32 || bits == 64 then (
 			ptr := getMemAtomic(bits / 8);
@@ -419,6 +435,7 @@ ffiRealValue(e:Expr):Expr := (
 	    is x:pointerCell do (
 		when a.1
 		is y:ZZcell do (
+		    if !isInt(y) then return WrongArgSmallInteger();
 		    bits := toInt(y);
 		    if bits == 0
 		    then toExpr(moveToRR(Ccode(RRmutable, "*(mpfr_ptr*)", x.v)))

diff --git a/M2/Macaulay2/d/gmp.d b/M2/Macaulay2/d/gmp.d
@@ -203,7 +203,7 @@ clear(x:RRimutable) ::= Ccode( void, "mpfi_clear(",  x, ")" );
 
 clear(z:CCmutable):void := ( clear(z.re); clear(z.im); );
 
-export copy(z:ZZ):ZZ := (
+export moveToZZ(z:ZZmutable):ZZ := (
      y := GCmalloc(ZZmutable);
      Ccode(void, "
 	  int s = z->_mp_size, ss = s>=0 ? s : -s;
@@ -212,14 +212,13 @@ export copy(z:ZZ):ZZ := (
 	  ",y,"->_mp_alloc = ss, ",y,"->_mp_size = s, ",y,"->_mp_d = p;
 	  ");
      Ccode(ZZ,y));
-export moveToZZ(z:ZZmutable):ZZ := copy(Ccode(ZZ, z));
 
 export moveToZZandclear(z:ZZmutable):ZZ := (
      w := moveToZZ(z);
      clear(z);
      w);
 
-export copy(z:RR):RR := (
+export moveToRR(z:RRmutable):RR := (
      y := GCmalloc(RRmutable);
      Ccode(void, "
   	  int limb_size = (",z,"->_mpfr_prec - 1) / GMP_NUMB_BITS + 1;
@@ -232,7 +231,6 @@ export copy(z:RR):RR := (
 	  ");
     Ccode(RR,y)
    );
-export moveToRR(z:RRmutable):RR := copy(Ccode(RR, z));
 
 export moveToRRi(z:RRimutable):RRi := (
     y := GCmalloc(RRimutable);