Import Debian changes 5c3-5debian/5c3-5

scm (5c3-5) frozen unstable; urgency=low

  * debian/rules chmod +x's bld.scm. Fixes #30521.

scm (5c3-4) frozen unstable; urgency=low

  * Made bld.scm executable.  Fixes #29578.

scm (5c3-3) frozen unstable; urgency=low

  * -nw
  * Fixes #16762. 
  * Fixes #18163.
  * Fixes #18164.
  * Fixes #23743.
  * Fixes #24098.
  * Fixes #24099.
  * Fixes #24547.

scm (5c3-2) frozen unstable; urgency=low

  * Re-uploading for slink freeze.

scm (5c3-1) unstable; urgency=low

  * New upstream version.

1 files changed, 65 insertions, 28 deletions

diff --git a/scl.c b/scl.c
index 8e89bd8..1b4507d 100644
--- a/scl.c
+++ b/scl.c
@@ -50,10 +50,11 @@
 static char s_makrect[] = "make-rectangular", s_makpolar[] = "make-polar",
 	    s_magnitude[] = "magnitude", s_angle[] = "angle",
 	    s_real_part[] = "real-part", s_imag_part[] = "imag-part",
-	    s_in2ex[] = "inexact->exact";
+	    s_in2ex[] = "inexact->exact",s_ex2in[] = "exact->inexact";
+
 static char s_expt[] = "$expt", s_atan2[] = "$atan2";
-static char s_memv[] = "memv", s_assv[] = "assv";
 #endif
+static char s_memv[] = "memv", s_assv[] = "assv";
 
 SCM sys_protects[NUM_PROTECTS];
 sizet num_protects = NUM_PROTECTS;
@@ -84,7 +85,7 @@ static double fx[] = {0.0, 5e-1, 5e-2, 5e-3, 5e-4, 5e-5,
 
 static sizet idbl2str(f, a)
      double f;
-char *a;
+     char *a;
 {
   int efmt, dpt, d, i, wp = dblprec;
   sizet ch = 0;
@@ -189,19 +190,17 @@ static sizet iflo2str(flt, str)
 }
 #endif				/* FLOATS */
 
-sizet iint2str(num, rad, p)
-     long num;
+sizet iuint2str(num, rad, p)
+     unsigned long num;
      int rad;
      char *p;
 {
   sizet j;
   register int i = 1, d;
-  register long n = num;
-  if (n < 0) {n = -n; i++;}
+  register unsigned long n = num;
   for (n /= rad;n > 0;n /= rad) i++;
   j = i;
   n = num;
-  if (n < 0) {n = -n; *p++ = '-'; i--;}
   while (i--) {
     d = n % rad;
     n /= rad;
@@ -209,6 +208,17 @@ sizet iint2str(num, rad, p)
   }
   return j;
 }
+sizet iint2str(num, rad, p)
+     long num;
+     int rad;
+     char *p;
+{
+  if ((num < 0) && !(rad < 0)) {
+    *p++ = '-';
+    return 1 + iuint2str((unsigned long) -num, rad, p);
+  }
+  return iuint2str((unsigned long) num, rad < 0 ? -rad : rad, p);
+}
 #ifdef BIGDIG
 static SCM big2str(b, radix)
      SCM b;
@@ -226,6 +236,7 @@ static SCM big2str(b, radix)
   BIGDIG radpow = 1, radmod = 0;
   SCM ss = makstr((long)j);
   char *s = CHARS(ss), c;
+  scm_protect_temp(&t);
   while ((long) radpow * radix < BIGRAD) {
     radpow *= radix;
     radct++;
@@ -671,8 +682,6 @@ SCM makdbl (x, y)
 {
   SCM z;
   if ((y==0.0) && (x==0.0)) return flo0;
-  NEWCELL(z);
-  DEFER_INTS;
   if (y==0.0) {
 # ifdef SINGLES
     float fx;
@@ -680,17 +689,29 @@ SCM makdbl (x, y)
     if ((-FLTMAX < x) && (x < FLTMAX) && ((fx=x)==x))
 #  endif
       {
+	NEWCELL(z);
+	DEFER_INTS;
 	CAR(z) = tc_flo;
 	FLO(z) = x;
 	ALLOW_INTS;
 	return z;
       }
 # endif				/* def SINGLES */
-    CDR(z) = (SCM)must_malloc(1L*sizeof(double), "real");
+    DEFER_INTS;
+# ifdef NUM_HP
+    CDR(z) = (SCM)num_hp_alloc(sizeof(double));
+# else
+    z = must_malloc_cell(1L*sizeof(double), "real");
+# endif
     CAR(z) = tc_dblr;
   }
   else {
-    CDR(z) = (SCM)must_malloc(2L*sizeof(double), "complex");
+    DEFER_INTS;
+# ifdef NUM_HP
+    CDR(z) = (SCM)num_hp_alloc(2L*sizeof(double));
+# else
+    z = must_malloc_cell(2L*sizeof(double), "complex");
+# endif
     CAR(z) = tc_dblc;
     IMAG(z) = y;
   }
@@ -698,7 +719,9 @@ SCM makdbl (x, y)
   ALLOW_INTS;
   return z;
 }
+#endif				/* FLOATS */
 
+#ifndef INUMS_ONLY
 SCM eqv(x, y)
      SCM x, y;
 {
@@ -711,9 +734,11 @@ SCM eqv(x, y)
 # ifdef BIGDIG
     if BIGP(x) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F;
 # endif
+# ifdef FLOATS
     if (REALPART(x) != REALPART(y)) return BOOL_F;
     if (CPLXP(x) && (IMAG(x) != IMAG(y))) return BOOL_F;
     return BOOL_T;
+# endif
   }
   return BOOL_F;
 }
@@ -746,7 +771,7 @@ SCM x, alist;
 # endif
   return BOOL_F;
 }
-#endif				/* FLOATS */
+#endif
 
 SCM list_tail(lst, k)
      SCM lst, k;
@@ -1905,7 +1930,8 @@ double ltrunc(x)
   if (x < 0.0) return -floor(-x);
   return floor(x);
 }
-double round(x)
+
+double scm_round(x)
      double x;
 {
   double plus_half = x + 0.5;
@@ -2063,10 +2089,17 @@ do_angle:
   return makdbl(atan2(y, x), 0.0);
 }
 
-double floident(z)
-     double z;
+
+SCM ex2in(z)
+     SCM z;
 {
-  return z;
+  if INUMP(z) return makdbl((double)INUM(z), 0.0);
+  ASRTGO(NIMP(z), badz);
+  if INEXP(z) return z;
+# ifdef BIGDIG
+  if BIGP(z) return makdbl(big2dbl(z), 0.0);
+# endif
+ badz: wta(z, (char *)ARG1, s_ex2in);
 }
 SCM in2ex(z)
      SCM z;
@@ -2257,6 +2290,7 @@ static iproc subr1s[] = {
 	{s_magnitude, magnitude},
 	{s_angle, angle},
 	{s_in2ex, in2ex},
+	{s_ex2in, ex2in},
 #else
 	{"real?", numberp},
 	{"rational?", numberp},
@@ -2289,13 +2323,15 @@ static iproc subr2s[] = {
 #ifdef FLOATS
 	{s_makrect, makrect},
 	{s_makpolar, makpolar},
-	{s_memv, memv},
-	{s_assv, assv},
 	{s_atan2, latan2},
 	{s_expt, expt},
+#endif
+#ifdef INUMS_ONLY
+	{s_memv, memq},
+	{s_assv, assq},
 #else
-	{"memv", memq},
-	{"assv", assq},
+	{s_memv, memv},
+	{s_assv, assv},
 #endif
 	{s_list_tail, list_tail},
 	{s_ve_fill, vector_fill},
@@ -2311,10 +2347,10 @@ static iproc subr2os[] = {
 	{0, 0}};
 
 static iproc rpsubrs[] = {
-#ifdef FLOATS
-	{"eqv?", eqv},
-#else
+#ifdef INUMS_ONLY
 	{"eqv?", eq},
+#else
+	{"eqv?", eqv},
 #endif
 	{s_eqp, eqp},
 	{s_lessp, lessp},
@@ -2328,7 +2364,7 @@ static dblproc cxrs[] = {
 	{"floor", floor},
 	{"ceiling", ceil},
 	{"truncate", ltrunc},
-	{"round", round},
+	{"round", scm_round},
 	{"$sqrt", sqrt},
 	{"$abs", fabs},
 	{"$exp", exp},
@@ -2346,7 +2382,6 @@ static dblproc cxrs[] = {
 	{"$asinh", lasinh},
 	{"$acosh", lacosh},
 	{"$atanh", latanh},
-	{"exact->inexact", floident},
 	{0, 0}};
 #endif
 
@@ -2372,14 +2407,16 @@ void init_scl()
 #endif
 #ifdef FLOATS
   init_iprocs((iproc *)cxrs, tc7_cxr);
-  NEWCELL(flo0);
 # ifdef SINGLES
+  NEWCELL(flo0);
   CAR(flo0) = tc_flo;
   FLO(flo0) = 0.0;
 # else
-  CDR(flo0) = (SCM)must_malloc(1L*sizeof(double), "real");
+  DEFER_INTS;
+  flo0 = must_malloc_cell(1L*sizeof(double), "real");
   REAL(flo0) = 0.0;
   CAR(flo0) = tc_dblr;
+  ALLOW_INTS;
 # endif
 # ifdef DBL_DIG
   dblprec = (DBL_DIG > 20) ? 20 : DBL_DIG;