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 ;;; 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.
 100 ;;;
 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)))
 108         ((>= index end) nil)
 109       (declare (fixnum index))
 110       (unless (zerop (logand (aref table (byte-ref index)) mask))
 111         (return index)))))
 112
 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))
 123         (return index)))))
 124
 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)))
 134         ((>= index end) nil)
 135       (declare (fixnum index))
 136       (when (char= (char-ref index) character)
 137         (return index)))))
 138
 139 ;;; Search STRING for CHARACTER from END to START. If the character is
 140 ;;; found, the corresponding index into STRING is returned, otherwise
 141 ;;; NIL is returned.
 142 (defun %sp-reverse-find-character (string start end character)
 143   (declare (type (or simple-string system-area-pointer) string)
 144            (fixnum start end)
 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)
 152           (return index)))))
 153
 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
 156 ;;; character.
 157 (defun %sp-skip-character (string start end character)
 158   (declare (type (or simple-string system-area-pointer) string)
 159            (fixnum start end)
 160            (base-char character))
 161   (maybe-sap-maybe-string (string)
 162     (do ((index start (1+ index)))
 163         ((= index end) nil)
 164       (declare (fixnum index))
 165       (if (char/= (char-ref index) character)
 166           (return index)))))
 167
 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)
 172            (fixnum start end)
 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)
 180           (return index)))))
 181
 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)))
 191               ((= index1 end1) t)
 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))
 196               (return nil)))
 197       (return index2))))