0.pre8.4
[sbcl.git] / src / code / mipsstrops.lisp
1 ;;;; string hacking functions that are stubs for things that might
2 ;;;; be microcoded someday
3
4 ;;;; This software is part of the SBCL system. See the README file for
5 ;;;; more information.
6 ;;;;
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.
12
13 (in-package "SB!IMPL")
14
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.
20 ;;;
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))
28     (cond
29      ((= len1 len2)
30       (do ((index1 start1 (1+ index1))
31            (index2 start2 (1+ index2)))
32           ((= index1 end1) nil)
33         (declare (fixnum index1 index2))
34         (if (char/= (schar string1 index1) (schar string2 index2))
35             (return index1))))
36      ((> len1 len2)
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))
42             (return index1))))
43      (t
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))
49             (return index1)))))))
50
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))
58     (cond
59      ((= 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))
65             (return index1))))
66      ((> len1 len2)
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))
72             (return index1))))
73      (t
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))
79             (return index1)))))))