From bc46ce69ee6ff38ac3dc708615cffb295f224242 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 28 Sep 2008 21:53:10 +0000
Subject: [PATCH] Change SET-FLOAT-ROUNDING-MODE to signal an error on failure.
 Eliminate several compiler warnings.

---
 v7/src/microcode/sysprim.c | 72 +++++++++++++++++++++-----------------
 1 file changed, 39 insertions(+), 33 deletions(-)

diff --git a/v7/src/microcode/sysprim.c b/v7/src/microcode/sysprim.c
index 13d3cc137..103bd9f7c 100644
--- a/v7/src/microcode/sysprim.c
+++ b/v7/src/microcode/sysprim.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: sysprim.c,v 9.57 2008/09/27 03:59:13 cph Exp $
+$Id: sysprim.c,v 9.58 2008/09/28 21:53:10 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -30,6 +30,7 @@ USA.
 
 #include "scheme.h"
 #include "prims.h"
+#include "osscheme.h"
 #include "ostty.h"
 #include "ostop.h"
 
@@ -199,7 +200,9 @@ Write FLOAT to memory at ADDRESS.")
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
-#pragma STDC FENV_ACCESS on
+#ifndef __GNUC__
+#  pragma STDC FENV_ACCESS on
+#endif
 
 enum { FRMODE_NEAREST, FRMODE_TOWARD_ZERO, FRMODE_DOWNWARD, FRMODE_UPWARD };
 
@@ -226,75 +229,78 @@ DEFINE_PRIMITIVE ("FLOAT-ROUNDING-MODES", Prim_float_rounding_modes, 0, 0, 0)
 
 DEFINE_PRIMITIVE ("GET-FLOAT-ROUNDING-MODE", Prim_get_float_rounding_mode, 0, 0, 0)
 {
-  int mode;
   PRIMITIVE_HEADER (0);
 #ifdef HAVE_FEGETROUND
-  mode = (fegetround ());
-  if (mode < 0)
-    error_external_return ();
-  switch (mode)
-    {
+  {
+    int mode = (fegetround ());
+    if (mode < 0)
+      error_external_return ();
+    switch (mode)
+      {
 #ifdef FE_TONEAREST
-    case FE_TONEAREST: PRIMITIVE_RETURN (ulong_to_integer (FRMODE_NEAREST));
+      case FE_TONEAREST: PRIMITIVE_RETURN (ulong_to_integer (FRMODE_NEAREST));
 #endif
 #ifdef FE_TOWARDZERO
-    case FE_TOWARDZERO: PRIMITIVE_RETURN (ulong_to_integer (FRMODE_TOWARD_ZERO));
+      case FE_TOWARDZERO: PRIMITIVE_RETURN (ulong_to_integer (FRMODE_TOWARD_ZERO));
 #endif
 #ifdef FE_DOWNWARD
-    case FE_DOWNWARD: PRIMITIVE_RETURN (ulong_to_integer (FRMODE_DOWNWARD));
+      case FE_DOWNWARD: PRIMITIVE_RETURN (ulong_to_integer (FRMODE_DOWNWARD));
 #endif
 #ifdef FE_UPWARD
-    case FE_UPWARD: PRIMITIVE_RETURN (ulong_to_integer (FRMODE_UPWARD));
+      case FE_UPWARD: PRIMITIVE_RETURN (ulong_to_integer (FRMODE_UPWARD));
 #endif
-    default: PRIMITIVE_RETURN (SHARP_F);
-    }
+      default: PRIMITIVE_RETURN (SHARP_F);
+      }
+  }
 #else
   error_unimplemented_primitive ();
   PRIMITIVE_RETURN (UNSPECIFIC);
 #endif
 }
 
+#ifdef HAVE_FESETROUND
 static int float_rounding_mode = (-1);
+#endif
 
 DEFINE_PRIMITIVE ("SET-FLOAT-ROUNDING-MODE", Prim_set_float_rounding_mode, 1, 1, 0)
 {
-  int mode = (-1);
   PRIMITIVE_HEADER (1);
 #ifdef HAVE_FESETROUND
-  switch (arg_ulong_integer (1))
-    {
+  {
+    int mode = (-1);
+    switch (arg_ulong_integer (1))
+      {
 #ifdef FE_TONEAREST
-    case FRMODE_NEAREST: mode = FE_TONEAREST; break;
+      case FRMODE_NEAREST: mode = FE_TONEAREST; break;
 #endif
 #ifdef FE_TOWARDZERO
-    case FRMODE_TOWARD_ZERO: mode = FE_TOWARDZERO; break;
+      case FRMODE_TOWARD_ZERO: mode = FE_TOWARDZERO; break;
 #endif
 #ifdef FE_DOWNWARD
-    case FRMODE_DOWNWARD: mode = FE_DOWNWARD; break;
+      case FRMODE_DOWNWARD: mode = FE_DOWNWARD; break;
 #endif
 #ifdef FE_UPWARD
-    case FRMODE_UPWARD: mode = FE_UPWARD; break;
+      case FRMODE_UPWARD: mode = FE_UPWARD; break;
 #endif
-    default: error_bad_range_arg (1); break;
-    }
-  if ((fesetround (mode)) == 0)
-    {
+      default: error_bad_range_arg (1); break;
+      }
+    if ((fesetround (mode)) != 0)
+      {
+	float_rounding_mode = (-1);
+	error_bad_range_arg (1);
+      }
+    else
       float_rounding_mode = mode;
-      PRIMITIVE_RETURN (SHARP_T);
-    }
-  else
-    {
-      float_rounding_mode = (-1);
-      PRIMITIVE_RETURN (SHARP_F);
-    }
+  }
 #else
   error_unimplemented_primitive ();
-  PRIMITIVE_RETURN (UNSPECIFIC);
 #endif
+  PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
 /* This kludge is to work around the fact that setjmp saves the
     floating-point rounding mode and longjmp restores it.  */
+
 void
 fixup_float_rounding_mode (void)
 {
-- 
2.25.1