This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow lvalue subs to return TEMPs
[perl5.git] / dist / Math-BigInt-FastCalc / FastCalc.xs
index d8a5445..9f9bb5e 100644 (file)
@@ -7,6 +7,11 @@
 #  define SvUOK(sv) SvIOK_UV(sv)
 #endif
 
+/* for Perl v5.6 (RT #63859) */
+#ifndef croak_xs_usage
+# define croak_xs_usage croak
+#endif
+
 double XS_BASE = 0;
 double XS_BASE_LEN = 0;
 
@@ -34,34 +39,31 @@ PROTOTYPES: DISABLE
       ST(0) = sv_2mortal(newSViv(value));      \
       XSRETURN(1);
 
-void 
-_set_XS_BASE(BASE, BASE_LEN)
-  SV* BASE
-  SV* BASE_LEN
-
-  CODE:
-    XS_BASE = SvNV(BASE); 
-    XS_BASE_LEN = SvIV(BASE_LEN); 
+BOOT:
+{
+    if (items < 4)
+       croak("Usage: Math::BigInt::FastCalc::BOOT(package, version, base_len, base)");
+    XS_BASE_LEN = SvIV(ST(2));
+    XS_BASE = SvNV(ST(3));
+}
 
 ##############################################################################
 # _new
 
-AV *
+SV *
 _new(class, x)
   SV*  x
   INIT:
     STRLEN len;
     char* cur;
     STRLEN part_len;
+    AV *av = newAV();
 
   CODE:
-    /* create the array */
-    RETVAL = newAV();
-    sv_2mortal((SV*)RETVAL);
     if (SvUOK(x) && SvUV(x) < XS_BASE)
       {
       /* shortcut for integer arguments */
-      av_push (RETVAL, newSVuv( SvUV(x) ));
+      av_push (av, newSVuv( SvUV(x) ));
       }
     else
       {
@@ -87,10 +89,11 @@ _new(class, x)
         /* printf ("part '%s' (part_len: %i, len: %i, BASE_LEN: %i)\n", cur, part_len, len, XS_BASE_LEN); */
         if (part_len > 0)
          {
-         av_push (RETVAL, newSVpvn(cur, part_len) );
+         av_push (av, newSVpvn(cur, part_len) );
          }
         }
       }
+    RETVAL = newRV_noinc((SV *)av);
   OUTPUT:
     RETVAL
 
@@ -258,54 +261,18 @@ _inc(class,x)
     XSRETURN(1);                       /* return x */
 
 ##############################################################################
-# Make a number (scalar int/float) from a BigInt object
 
-void
-_num(class,x)
-  SV*  x
-  INIT:
-    AV*        a;
-    NV fac;
-    SV*        temp;
-    NV num;
-    I32        elems;
-    I32        index;
-    NV BASE;
-
-  CODE:
-    a = (AV*)SvRV(x);                  /* ref to aray, don't check ref */
-    elems = av_len(a);                 /* number of elems in array */
-
-    if (elems == 0)                    /* only one element? */
-      {
-      ST(0) = *av_fetch(a, 0, 0);      /* fetch first (only) element */
-      XSRETURN(1);                     /* return it */
-      }
-    fac = 1.0;                         /* factor */
-    index = 0;
-    num = 0.0;
-    BASE = XS_BASE;
-    while (index <= elems)
-      {
-      temp = *av_fetch(a, index, 0);   /* fetch current element */
-      num += fac * SvNV(temp);
-      fac *= BASE;
-      index++;
-      }
-    ST(0) = newSVnv(num);
-
-##############################################################################
-
-AV *
+SV *
 _zero(class)
   ALIAS:
     _one = 1
     _two = 2
     _ten = 10
+  PREINIT:
+    AV *av = newAV();
   CODE:
-    RETVAL = newAV();
-    sv_2mortal((SV*)RETVAL);
-    av_push (RETVAL, newSViv( ix ));
+    av_push (av, newSViv( ix ));
+    RETVAL = newRV_noinc((SV *)av);
   OUTPUT:
     RETVAL
 
@@ -348,7 +315,7 @@ _is_zero(class, x)
       SV *const temp = *av_fetch(a, 0, 0);     /* fetch first element */
       ST(0) = boolSV(SvIV(temp) == ix);
       }
-    XSRETURN(1);               
+    XSRETURN(1);
 
 ##############################################################################
 
@@ -402,7 +369,7 @@ _acmp(class, cx, cy);
       RETURN_MORTAL_INT(-1);           /* len differs: X < Y */
       }
     /* both have same number of elements, so check length of last element
-       and see if it differes */
+       and see if it differs */
     tempx = *av_fetch(array_x, elemsx, 0);     /* fetch last element */
     tempy = *av_fetch(array_y, elemsx, 0);     /* fetch last element */
     SvPV(tempx, lenx);                 /* convert to string & store length */