Skip to content
Snippets Groups Projects
Commit 643190af authored by wlott's avatar wlott
Browse files

Generalized the various string search functions to take either a string or

a sap.
parent a796fba9
No related branches found
No related tags found
No related merge requests found
...@@ -90,31 +90,48 @@ be simple strings." ...@@ -90,31 +90,48 @@ be simple strings."
(if (char/= (schar string1 index1) (schar string2 index2)) (if (char/= (schar string1 index1) (schar string2 index2))
(return index1))))))) (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) (defun %sp-find-character-with-attribute (string start end table mask)
(declare (type (simple-array (unsigned-byte 8) (256)) table) (declare (type (simple-array (unsigned-byte 8) (256)) table)
(simple-string string) (type (or simple-string system-area-pointer) string)
(fixnum start end mask)) (fixnum start end mask))
"%SP-Find-Character-With-Attribute String, Start, End, Table, 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 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 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 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." index into the String is returned. The corresponds to SCANC on the Vax."
(do ((index start (1+ index))) (maybe-sap-maybe-string (string)
((>= index end) nil) (do ((index start (1+ index)))
(declare (fixnum index)) ((>= index end) nil)
(unless (zerop (logand (aref table (char-code (schar string index))) mask)) (declare (fixnum index))
(return index)))) (unless (zerop (logand (aref table (byte-ref index)) mask))
(return index)))))
(defun %sp-reverse-find-character-with-attribute (string start end table mask) (defun %sp-reverse-find-character-with-attribute (string start end table mask)
"Like %SP-Find-Character-With-Attribute, only sdrawkcaB." "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) (fixnum start end mask)
(type (array (unsigned-byte 8) (256)) table)) (type (array (unsigned-byte 8) (256)) table))
(do ((index (1- end) (1- index))) (maybe-sap-maybe-string (string)
((< index start) nil) (do ((index (1- end) (1- index)))
(declare (fixnum index)) ((< index start) nil)
(unless (zerop (logand (aref table (char-code (schar string index))) mask)) (declare (fixnum index))
(return index)))) (unless (zerop (logand (aref table (byte-ref index)) mask))
(return index)))))
(defun %sp-find-character (string start end character) (defun %sp-find-character (string start end character)
"%SP-Find-Character String, Start, End, Character "%SP-Find-Character String, Start, End, Character
...@@ -122,52 +139,59 @@ be simple strings." ...@@ -122,52 +139,59 @@ be simple strings."
found, the corresponding index into String is returned, otherwise NIL is found, the corresponding index into String is returned, otherwise NIL is
returned." returned."
(declare (fixnum start end) (declare (fixnum start end)
(simple-string string) (type (or simple-string system-area-pointer) string)
(base-character character)) (base-character character))
(do ((index start (1+ index))) (maybe-sap-maybe-string (string)
((>= index end) nil) (do ((index start (1+ index)))
(declare (fixnum index)) ((>= index end) nil)
(when (char= (schar string index) character) (declare (fixnum index))
(return index)))) (when (char= (char-ref index) character)
(return index)))))
(defun %sp-reverse-find-character (string start end character) (defun %sp-reverse-find-character (string start end character)
(declare (simple-string string)) (declare (type (or simple-string system-area-pointer) string)
(declare (fixnum start end)) (fixnum start end)
(base-character character))
"%SP-Reverse-Find-Character String, Start, End, Character "%SP-Reverse-Find-Character String, Start, End, Character
Searches String for Character from End to Start. If the character is Searches String for Character from End to Start. If the character is
found, the corresponding index into String is returned, otherwise NIL is found, the corresponding index into String is returned, otherwise NIL is
returned." returned."
(do ((index (1- end) (1- index)) (maybe-sap-maybe-string (string)
(terminus (1- start))) (do ((index (1- end) (1- index))
((= index terminus) nil) (terminus (1- start)))
(declare (fixnum terminus index)) ((= index terminus) nil)
(if (char= (char string index) character) (declare (fixnum terminus index))
(return index)))) (if (char= (char-ref index) character)
(return index)))))
(defun %sp-skip-character (string start end character) (defun %sp-skip-character (string start end character)
(declare (simple-string string)) (declare (type (or simple-string system-area-pointer) string)
(declare (fixnum start end)) (fixnum start end)
(base-character character))
"%SP-Skip-Character String, Start, End, Character "%SP-Skip-Character String, Start, End, Character
Returns the index of the first character between Start and End which 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." is not Char= to Character, or NIL if there is no such character."
(do ((index start (1+ index))) (maybe-sap-maybe-string (string)
((= index end) nil) (do ((index start (1+ index)))
(declare (fixnum index)) ((= index end) nil)
(if (char/= (char string index) character) (declare (fixnum index))
(return index)))) (if (char/= (char-ref index) character)
(return index)))))
(defun %sp-reverse-skip-character (string start end character) (defun %sp-reverse-skip-character (string start end character)
(declare (simple-string string)) (declare (type (or simple-string system-area-pointer) string)
(declare (fixnum start end)) (fixnum start end)
(base-character character))
"%SP-Skip-Character String, Start, End, Character "%SP-Skip-Character String, Start, End, Character
Returns the index of the last character between Start and End which 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." is not Char= to Character, or NIL if there is no such character."
(do ((index (1- end) (1- index)) (maybe-sap-maybe-string (string)
(terminus (1- start))) (do ((index (1- end) (1- index))
((= index terminus) nil) (terminus (1- start)))
(declare (fixnum terminus index)) ((= index terminus) nil)
(if (char/= (char string index) character) (declare (fixnum terminus index))
(return index)))) (if (char/= (char-ref index) character)
(return index)))))
(defun %sp-string-search (string1 start1 end1 string2 start2 end2) (defun %sp-string-search (string1 start1 end1 string2 start2 end2)
"%SP-String-Search String1, Start1, End1, String2, Start2, End2 "%SP-String-Search String1, Start1, End1, String2, Start2, End2
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment