From 643190af3de809846b345bf988361e53c5bccd0c Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sat, 8 Sep 1990 17:23:26 +0000
Subject: [PATCH] Generalized the various string search functions to take
 either a string or a sap.

---
 code/mipsstrops.lisp | 106 ++++++++++++++++++++++++++-----------------
 1 file changed, 65 insertions(+), 41 deletions(-)

diff --git a/code/mipsstrops.lisp b/code/mipsstrops.lisp
index 5a57ee9b8..97ceae414 100644
--- a/code/mipsstrops.lisp
+++ b/code/mipsstrops.lisp
@@ -90,31 +90,48 @@ be simple strings."
 	(if (char/= (schar string1 index1) (schar string2 index2))
 	    (return index1)))))))
 
+(defmacro maybe-sap-maybe-string ((var) &body body)
+  `(etypecase ,var
+     (system-area-pointer
+      (macrolet ((byte-ref (index)
+		   `(sap-ref-8 ,',var ,index))
+		 (char-ref (index)
+		   `(code-char (byte-ref ,index))))
+	,@body))
+     (simple-string
+      (macrolet ((char-ref (index)
+		   `(schar ,',var ,index))
+		 (byte-ref (index)
+		   `(char-code (char-ref ,index))))
+	,@body))))
+
 (defun %sp-find-character-with-attribute (string start end table mask)
   (declare (type (simple-array (unsigned-byte 8) (256)) table)
-	   (simple-string string)
+	   (type (or simple-string system-area-pointer) string)
 	   (fixnum start end mask))
   "%SP-Find-Character-With-Attribute  String, Start, End, Table, Mask
   The codes of the characters of String from Start to End are used as indices
   into the Table, which is a U-Vector of 8-bit bytes. When the number picked
   up from the table bitwise ANDed with Mask is non-zero, the current
   index into the String is returned. The corresponds to SCANC on the Vax."
-  (do ((index start (1+ index)))
-      ((>= index end) nil)
-    (declare (fixnum index))
-    (unless (zerop (logand (aref table (char-code (schar string index))) mask))
-      (return index))))
+  (maybe-sap-maybe-string (string)
+    (do ((index start (1+ index)))
+	((>= index end) nil)
+      (declare (fixnum index))
+      (unless (zerop (logand (aref table (byte-ref index)) mask))
+	(return index)))))
 
 (defun %sp-reverse-find-character-with-attribute (string start end table mask)
   "Like %SP-Find-Character-With-Attribute, only sdrawkcaB."
-  (declare (simple-string string)
+  (declare (type (or simple-string system-area-pointer) string)
 	   (fixnum start end mask)
 	   (type (array (unsigned-byte 8) (256)) table))
-  (do ((index (1- end) (1- index)))
-      ((< index start) nil)
-    (declare (fixnum index))
-    (unless (zerop (logand (aref table (char-code (schar string index))) mask))
-      (return index))))
+  (maybe-sap-maybe-string (string)
+    (do ((index (1- end) (1- index)))
+	((< index start) nil)
+      (declare (fixnum index))
+      (unless (zerop (logand (aref table (byte-ref index)) mask))
+	(return index)))))
 
 (defun %sp-find-character (string start end character)
   "%SP-Find-Character  String, Start, End, Character
@@ -122,52 +139,59 @@ be simple strings."
   found, the corresponding index into String is returned, otherwise NIL is
   returned."
   (declare (fixnum start end)
-	   (simple-string string)
+	   (type (or simple-string system-area-pointer) string)
 	   (base-character character))
-  (do ((index start (1+ index)))
-      ((>= index end) nil)
-    (declare (fixnum index))
-    (when (char= (schar string index) character)
-      (return index))))
+  (maybe-sap-maybe-string (string)
+    (do ((index start (1+ index)))
+	((>= index end) nil)
+      (declare (fixnum index))
+      (when (char= (char-ref index) character)
+	(return index)))))
 
 (defun %sp-reverse-find-character (string start end character)
-  (declare (simple-string string))
-  (declare (fixnum start end))
+  (declare (type (or simple-string system-area-pointer) string)
+	   (fixnum start end)
+	   (base-character character))
   "%SP-Reverse-Find-Character  String, Start, End, Character
   Searches String for Character from End to Start.  If the character is
   found, the corresponding index into String is returned, otherwise NIL is
   returned."
-  (do ((index (1- end) (1- index))
-       (terminus (1- start)))
-      ((= index terminus) nil)
-    (declare (fixnum terminus index))
-    (if (char= (char string index) character)
-	(return index))))
+  (maybe-sap-maybe-string (string)
+    (do ((index (1- end) (1- index))
+	 (terminus (1- start)))
+	((= index terminus) nil)
+      (declare (fixnum terminus index))
+      (if (char= (char-ref index) character)
+	  (return index)))))
 
 (defun %sp-skip-character (string start end character)
-  (declare (simple-string string))
-  (declare (fixnum start end))
+  (declare (type (or simple-string system-area-pointer) string)
+	   (fixnum start end)
+	   (base-character character))
   "%SP-Skip-Character  String, Start, End, Character
   Returns the index of the first character between Start and End which
   is not Char=  to Character, or NIL if there is no such character."
-  (do ((index start (1+ index)))
-      ((= index end) nil)
-    (declare (fixnum index))
-    (if (char/= (char string index) character)
-	(return index))))
+  (maybe-sap-maybe-string (string)
+    (do ((index start (1+ index)))
+	((= index end) nil)
+      (declare (fixnum index))
+      (if (char/= (char-ref index) character)
+	  (return index)))))
 
 (defun %sp-reverse-skip-character (string start end character)
-  (declare (simple-string string))
-  (declare (fixnum start end))
+  (declare (type (or simple-string system-area-pointer) string)
+	   (fixnum start end)
+	   (base-character character))
   "%SP-Skip-Character  String, Start, End, Character
   Returns the index of the last character between Start and End which
   is not Char=  to Character, or NIL if there is no such character."
-  (do ((index (1- end) (1- index))
-       (terminus (1- start)))
-      ((= index terminus) nil)
-    (declare (fixnum terminus index))
-    (if (char/= (char string index) character)
-	(return index))))
+  (maybe-sap-maybe-string (string)
+    (do ((index (1- end) (1- index))
+	 (terminus (1- start)))
+	((= index terminus) nil)
+      (declare (fixnum terminus index))
+      (if (char/= (char-ref index) character)
+	  (return index)))))
 
 (defun %sp-string-search (string1 start1 end1 string2 start2 end2)
   "%SP-String-Search  String1, Start1, End1, String2, Start2, End2
-- 
GitLab