From 2a9956c99532e95a3bb2c88854ea619fc17f6da7 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 13 Jan 1987 19:33:40 +0000 Subject: [PATCH] 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++)) --- v7/src/microcode/char.c | 25 +++++++++++++++++++++---- v7/src/microcode/string.c | 26 ++++++++++++-------------- 2 files changed, 33 insertions(+), 18 deletions(-) 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 #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)); } -- 2.25.1