From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 13 Jan 1987 19:33:40 +0000 (+0000)
Subject: Change macro `Real_To_Upper' to procedure `char_upcase'; similarly for
X-Git-Tag: 20090517-FFI~13741
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2a9956c99532e95a3bb2c88854ea619fc17f6da7;p=mit-scheme.git
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 34cd6c6ab..8c963d1d4 100644
--- 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>
#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))));
}
+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 c1e31ae24..196444265 100644
--- 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);
}
@@ -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));
}