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)))))))
  80
  81 (defmacro maybe-sap-maybe-string ((var) &body body)
  82   `(etypecase ,var
  83      (system-area-pointer
  84       (macrolet ((byte-ref (index)
  85                    `(sap-ref-8 ,',var ,index))
  86                  (char-ref (index)
  87                    `(code-char (byte-ref ,index))))
  88         ,@body))
  89      (simple-string
  90       (macrolet ((char-ref (index)
  91                    `(schar ,',var ,index))
  92                  (byte-ref (index)
  93                    `(char-code (char-ref ,index))))
  94         ,@body))))
  95
  96 ;;; Search STRING for the CHARACTER from START to END. If the
  97 ;;; character is found, the corresponding index into STRING is
  98 ;;; returned, otherwise NIL is returned.
  99 (defun %sp-find-character (string start end character)
 100   (declare (fixnum start end)
 101            (type (or simple-string system-area-pointer) string)
 102            (base-char character))
 103   (maybe-sap-maybe-string (string)
 104     (do ((index start (1+ index)))
 105         ((>= index end) nil)
 106       (declare (fixnum index))
 107       (when (char= (char-ref index) character)
 108         (return index)))))
 109
 110 ;;; Search STRING for CHARACTER from END to START. If the character is
 111 ;;; found, the corresponding index into STRING is returned, otherwise
 112 ;;; NIL is returned.
 113 (defun %sp-reverse-find-character (string start end character)
 114   (declare (type (or simple-string system-area-pointer) string)
 115            (fixnum start end)
 116            (base-char character))
 117   (maybe-sap-maybe-string (string)
 118     (do ((index (1- end) (1- index))
 119          (terminus (1- start)))
 120         ((= index terminus) nil)
 121       (declare (fixnum terminus index))
 122       (if (char= (char-ref index) character)
 123           (return index)))))
 124
 125 ;;; Return the index of the first character between START and END
 126 ;;; which is not CHAR= to CHARACTER, or NIL if there is no such
 127 ;;; character.
 128 (defun %sp-skip-character (string start end character)
 129   (declare (type (or simple-string system-area-pointer) string)
 130            (fixnum start end)
 131            (base-char character))
 132   (maybe-sap-maybe-string (string)
 133     (do ((index start (1+ index)))
 134         ((= index end) nil)
 135       (declare (fixnum index))
 136       (if (char/= (char-ref index) character)
 137           (return index)))))
 138
 139 ;;; Return the index of the last character between START and END which
 140 ;;; is not CHAR= to CHARACTER, or NIL if there is no such character.
 141 (defun %sp-reverse-skip-character (string start end character)
 142   (declare (type (or simple-string system-area-pointer) string)
 143            (fixnum start end)
 144            (base-char character))
 145   (maybe-sap-maybe-string (string)
 146     (do ((index (1- end) (1- index))
 147          (terminus (1- start)))
 148         ((= index terminus) nil)
 149       (declare (fixnum terminus index))
 150       (if (char/= (char-ref index) character)
 151           (return index)))))
 152
 153 ;;; Search for the substring of STRING1 specified in STRING2. Return
 154 ;;; an index into STRING2, or NIL if the substring wasn't found.
 155 (defun %sp-string-search (string1 start1 end1 string2 start2 end2)
 156   (declare (simple-string string1 string2))
 157   (do ((index2 start2 (1+ index2)))
 158       ((= index2 end2) nil)
 159     (declare (fixnum index2))
 160     (when (do ((index1 start1 (1+ index1))
 161                (index2 index2 (1+ index2)))
 162               ((= index1 end1) t)
 163             (declare (fixnum index1 index2))
 164             (when (= index2 end2)
 165               (return-from %sp-string-search nil))
 166             (when (char/= (char string1 index1) (char string2 index2))
 167               (return nil)))
 168       (return index2))))