Change macro `Real_To_Upper' to procedure `char_upcase'; similarly for

`char_downcase'.  This fixes a class of problems such as:

	(Real_To_Upper (*scan++))

diff --git a/v7/src/microcode/char.c b/v7/src/microcode/char.c
index 34cd6c6ab1d2f31878d076a65fc739ea72c95088..8c963d1d49fbbc5a7b8de0e8ff06eba8bd3635f3 100644 (file)
--- a/v7/src/microcode/char.c
+++ b/v7/src/microcode/char.c
@@ -30,13 +30,14 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 5.2 1987/01/12 17:08:12 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 5.3 1987/01/13 19:33:40 cph Exp $ */
 
 /* Character primitives. */
 
 #include "scheme.h"
 #include "primitive.h"
 #include "character.h"
+#include <ctype.h>
 \f
 #define define_ascii_character_guarantee(procedure_name, wta, bra) \
 long                                                           \
@@ -190,12 +191,28 @@ Built_In_Primitive (Prim_Integer_To_Char, 1, "INTEGER->CHAR")
                       (guarantee_index_arg_1 (Arg1, MAX_EXTNDD_CHAR))));
 }
 \f
+long
+char_downcase (c)
+     long c;
+{
+  c = (char_to_long (c));
+  return ((isupper (c)) ? ((c - 'A') + 'a') : c);
+}
+
+long
+char_upcase (c)
+     long c;
+{
+  c = (char_to_long (c));
+  return ((islower (c)) ? ((c - 'a') + 'A') : c);
+}
+
 Built_In_Primitive (Prim_Char_Downcase, 1, "CHAR-DOWNCASE")
 {
   Primitive_1_Arg ();
 
   guarantee_character_arg_1 ();
-  return (make_char ((char_bits (Arg1)), (Real_To_Lower (char_code (Arg1)))));
+  return (make_char ((char_bits (Arg1)), (char_downcase (char_code (Arg1)))));
 }
 
 Built_In_Primitive (Prim_Char_Upcase, 1, "CHAR-UPCASE")
@@ -203,7 +220,7 @@ Built_In_Primitive (Prim_Char_Upcase, 1, "CHAR-UPCASE")
   Primitive_1_Arg ();
 
   guarantee_character_arg_1 ();
-  return (make_char ((char_bits (Arg1)), (Real_To_Upper (char_code (Arg1)))));
+  return (make_char ((char_bits (Arg1)), (char_upcase (char_code (Arg1)))));
 }
 
 Built_In_Primitive (Prim_Ascii_To_Char, 1, "ASCII->CHAR")
@@ -262,7 +279,7 @@ mit_ascii_to_ascii (mit_ascii)
     {
       if ((bucky_bits & CHAR_BITS_CONTROL) != 0)
        {
-         code = (Real_To_Upper (code) & (~ 0100));
+         code = (char_upcase (code) & (~ 0100));
          if (!ascii_control_p (code))
            return (NOT_ASCII);
        }

diff --git a/v7/src/microcode/string.c b/v7/src/microcode/string.c
index c1e31ae24730143ab7e7897123574ad644f19846..196444265f14aef36180caea46978494f5a3a5f9 100644 (file)
--- a/v7/src/microcode/string.c
+++ b/v7/src/microcode/string.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/string.c,v 5.3 1987/01/12 17:20:13 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/string.c,v 5.4 1987/01/13 19:33:08 cph Exp $ */
 
 /* String primitives. */
 
@@ -255,15 +255,14 @@ Built_In_Primitive (Prim_Vector_8b_Find_Previous_Char, 4,
 Built_In_Primitive(Prim_Vector_8b_Find_Next_Char_Ci, 4,
                   "VECTOR-8B-FIND-NEXT-CHAR-CI")
 {
-  char char1, char2;
+  char char1;
   vector_8b_substring_prefix ();
 
   scan = (string_pointer (Arg1, start));
-  char1 = Real_To_Upper (ascii);
+  char1 = (char_upcase (ascii));
   while (start < end)
     {
-      char2 = (*scan++);
-      if ((Real_To_Upper (char2)) == char1)
+      if ((char_upcase (*scan++)) == char1)
        return (Make_Unsigned_Fixnum( start));
       start += 1;
     }
@@ -273,15 +272,14 @@ Built_In_Primitive(Prim_Vector_8b_Find_Next_Char_Ci, 4,
 Built_In_Primitive(Prim_Vector_8b_Find_Previous_Char_Ci, 4,
                   "VECTOR-8B-FIND-PREVIOUS-CHAR-CI")
 {
-  char char1, char2;
+  char char1;
   vector_8b_substring_prefix ();
 
   scan = (string_pointer (Arg1, end));
-  char1 = Real_To_Upper (ascii);
+  char1 = (char_upcase (ascii));
   while (end-- > start)
     {
-      char2 = (*--scan);
-      if ((Real_To_Upper (char2)) == char1)
+      if ((char_upcase (*--scan)) == char1)
        return (Make_Unsigned_Fixnum (end));
     }
   return (NIL);
@@ -381,7 +379,7 @@ Built_In_Primitive(Prim_Substring_Ci_Equal, 6, "SUBSTRING-CI=?")
   substring_equal_prefix ();
 
   while (length-- > 0)
-    if ((Real_To_Upper (*scan1++)) != (Real_To_Upper (*scan2++)))
+    if ((char_upcase (*scan1++)) != (char_upcase (*scan2++)))
       return (NIL);
   return (TRUTH);
 }
@@ -424,7 +422,7 @@ Built_In_Primitive(Prim_Substring_Upcase, 3, "SUBSTRING-UPCASE!")
   substring_modification_prefix ();
 
   while (length-- > 0)
-    *scan++ = (Real_To_Upper (*scan));
+    *scan++ = (char_upcase (*scan));
   return (NIL);
 }
 
@@ -433,7 +431,7 @@ Built_In_Primitive(Prim_Substring_Downcase, 3, "SUBSTRING-DOWNCASE!")
   substring_modification_prefix ();
 
   while (length-- > 0)
-    *scan++ = (Real_To_Lower (*scan));
+    *scan++ = (char_downcase (*scan));
   return (NIL);
 }
 \f
@@ -460,7 +458,7 @@ Built_In_Primitive (Prim_Substring_Match_Forward_Ci, 6,
   substring_match_prefix (start1, start2);
 
   while (unmatched-- > 0)
-    if ((Real_To_Upper (*scan1++)) != (Real_To_Upper (*scan2++)))
+    if ((char_upcase (*scan1++)) != (char_upcase (*scan2++)))
       return (Make_Unsigned_Fixnum (length - (unmatched + 1)));
   return (Make_Unsigned_Fixnum (length));
 }
@@ -482,7 +480,7 @@ Built_In_Primitive(Prim_Substring_Match_Backward_Ci, 6,
   substring_match_prefix (end1, end2);
 
   while (unmatched-- > 0)
-    if ((Real_To_Upper (*--scan1)) != (Real_To_Upper (*--scan2)))
+    if ((char_upcase (*--scan1)) != (char_upcase (*--scan2)))
       return (Make_Unsigned_Fixnum (length - (unmatched + 1)));
   return (Make_Unsigned_Fixnum (length));
 }