1 ;;;; string hacking functions that are stubs for things that might
2 ;;;; be microcoded someday
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
13 (in-package "SB!IMPL")
15 ;;; Compare the substrings specified by STRING1 and STRING2 and return
16 ;;; NIL if the strings are STRING=, or the lowest index of STRING1 in
17 ;;; which the two differ. If one string is longer than the other and
18 ;;; the shorter is a prefix of the longer, the length of the shorter +
19 ;;; START1 is returned. The arguments must be simple strings.
21 ;;; This would be done on the Vax with CMPC3.
22 (defun %sp-string-compare (string1 start1 end1 string2 start2 end2)
23 (declare (simple-string string1 string2))
24 (declare (fixnum start1 end1 start2 end2))
25 (let ((len1 (- end1 start1))
26 (len2 (- end2 start2)))
27 (declare (fixnum len1 len2))
30 (do ((index1 start1 (1+ index1))
31 (index2 start2 (1+ index2)))
33 (declare (fixnum index1 index2))
34 (if (char/= (schar string1 index1) (schar string2 index2))
37 (do ((index1 start1 (1+ index1))
38 (index2 start2 (1+ index2)))
39 ((= index2 end2) index1)
40 (declare (fixnum index1 index2))
41 (if (char/= (schar string1 index1) (schar string2 index2))
44 (do ((index1 start1 (1+ index1))
45 (index2 start2 (1+ index2)))
46 ((= index1 end1) index1)
47 (declare (fixnum index1 index2))
48 (if (char/= (schar string1 index1) (schar string2 index2))
51 ;;; like %SP-STRING-COMPARE, only backwards
52 (defun %sp-reverse-string-compare (string1 start1 end1 string2 start2 end2)
53 (declare (simple-string string1 string2))
54 (declare (fixnum start1 end1 start2 end2))
55 (let ((len1 (- end1 start1))
56 (len2 (- end2 start2)))
57 (declare (fixnum len1 len2))
60 (do ((index1 (1- end1) (1- index1))
61 (index2 (1- end2) (1- index2)))
62 ((< index1 start1) nil)
63 (declare (fixnum index1 index2))
64 (if (char/= (schar string1 index1) (schar string2 index2))
67 (do ((index1 (1- end1) (1- index1))
68 (index2 (1- end2) (1- index2)))
69 ((< index2 start2) index1)
70 (declare (fixnum index1 index2))
71 (if (char/= (schar string1 index1) (schar string2 index2))
74 (do ((index1 (1- end1) (1- index1))
75 (index2 (1- end2) (1- index2)))
76 ((< index1 start1) index1)
77 (declare (fixnum index1 index2))
78 (if (char/= (schar string1 index1) (schar string2 index2))
81 (defmacro maybe-sap-maybe-string ((var) &body body)
84 (macrolet ((byte-ref (index)
85 `(sap-ref-8 ,',var ,index))
87 `(code-char (byte-ref ,index))))
90 (macrolet ((char-ref (index)
91 `(schar ,',var ,index))
93 `(char-code (char-ref ,index))))
96 ;;; The codes of the characters of STRING from START to END are used
97 ;;; as indices into the TABLE, which is a U-Vector of 8-bit bytes.
98 ;;; When the number picked up from the table bitwise ANDed with MASK
99 ;;; is non-zero, the current index into the STRING is returned.
101 ;;; (This corresponds to SCANC on the Vax.)
102 (defun %sp-find-character-with-attribute (string start end table mask)
103 (declare (type (simple-array (unsigned-byte 8) (256)) table)
104 (type (or simple-string system-area-pointer) string)
105 (fixnum start end mask))
106 (maybe-sap-maybe-string (string)
107 (do ((index start (1+ index)))
109 (declare (fixnum index))
110 (unless (zerop (logand (aref table (byte-ref index)) mask))
113 ;;; like %SP-FIND-CHARACTER-WITH-ATTRIBUTE, only sdrawkcaB
114 (defun %sp-reverse-find-character-with-attribute (string start end table mask)
115 (declare (type (or simple-string system-area-pointer) string)
116 (fixnum start end mask)
117 (type (array (unsigned-byte 8) (256)) table))
118 (maybe-sap-maybe-string (string)
119 (do ((index (1- end) (1- index)))
120 ((< index start) nil)
121 (declare (fixnum index))
122 (unless (zerop (logand (aref table (byte-ref index)) mask))
125 ;;; Search STRING for the CHARACTER from START to END. If the
126 ;;; character is found, the corresponding index into STRING is
127 ;;; returned, otherwise NIL is returned.
128 (defun %sp-find-character (string start end character)
129 (declare (fixnum start end)
130 (type (or simple-string system-area-pointer) string)
131 (base-char character))
132 (maybe-sap-maybe-string (string)
133 (do ((index start (1+ index)))
135 (declare (fixnum index))
136 (when (char= (char-ref index) character)
139 ;;; Search STRING for CHARACTER from END to START. If the character is
140 ;;; found, the corresponding index into STRING is returned, otherwise
142 (defun %sp-reverse-find-character (string start end character)
143 (declare (type (or simple-string system-area-pointer) string)
145 (base-char character))
146 (maybe-sap-maybe-string (string)
147 (do ((index (1- end) (1- index))
148 (terminus (1- start)))
149 ((= index terminus) nil)
150 (declare (fixnum terminus index))
151 (if (char= (char-ref index) character)
154 ;;; Return the index of the first character between START and END
155 ;;; which is not CHAR= to CHARACTER, or NIL if there is no such
157 (defun %sp-skip-character (string start end character)
158 (declare (type (or simple-string system-area-pointer) string)
160 (base-char character))
161 (maybe-sap-maybe-string (string)
162 (do ((index start (1+ index)))
164 (declare (fixnum index))
165 (if (char/= (char-ref index) character)
168 ;;; Return the index of the last character between START and END which
169 ;;; is not CHAR= to CHARACTER, or NIL if there is no such character.
170 (defun %sp-reverse-skip-character (string start end character)
171 (declare (type (or simple-string system-area-pointer) string)
173 (base-char character))
174 (maybe-sap-maybe-string (string)
175 (do ((index (1- end) (1- index))
176 (terminus (1- start)))
177 ((= index terminus) nil)
178 (declare (fixnum terminus index))
179 (if (char/= (char-ref index) character)
182 ;;; Search for the substring of STRING1 specified in STRING2. Return
183 ;;; an index into STRING2, or NIL if the substring wasn't found.
184 (defun %sp-string-search (string1 start1 end1 string2 start2 end2)
185 (declare (simple-string string1 string2))
186 (do ((index2 start2 (1+ index2)))
187 ((= index2 end2) nil)
188 (declare (fixnum index2))
189 (when (do ((index1 start1 (1+ index1))
190 (index2 index2 (1+ index2)))
192 (declare (fixnum index1 index2))
193 (when (= index2 end2)
194 (return-from %sp-string-search nil))
195 (when (char/= (char string1 index1) (char string2 index2))