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 (file-comment
  16   "$Header$")
  17
  18 ;(defun %sp-byte-blt (src-string src-start dst-string dst-start dst-end)
  19 ;  "Moves bytes from Src-String into Dst-String between Dst-Start (inclusive)
  20 ;and Dst-End (exclusive) (Dst-Start - Dst-End bytes are moved). Overlap of the
  21 ;strings does not affect the result. This would be done on the Vax
  22 ;with MOVC3. The arguments do not need to be strings: 8-bit U-Vectors
  23 ;are also acceptable."
  24 ;  (%primitive byte-blt src-string src-start dst-string dst-start dst-end))
  25
  26 (defun %sp-string-compare (string1 start1 end1 string2 start2 end2)
  27   (declare (simple-string string1 string2))
  28   (declare (fixnum start1 end1 start2 end2))
  29   #!+sb-doc
  30   "Compares the substrings specified by String1 and String2 and returns
  31 NIL if the strings are String=, or the lowest index of String1 in
  32 which the two differ. If one string is longer than the other and the
  33 shorter is a prefix of the longer, the length of the shorter + start1 is
  34 returned. This would be done on the Vax with CMPC3. The arguments must
  35 be simple strings."
  36   (let ((len1 (- end1 start1))
  37         (len2 (- end2 start2)))
  38     (declare (fixnum len1 len2))
  39     (cond
  40      ((= len1 len2)
  41       (do ((index1 start1 (1+ index1))
  42            (index2 start2 (1+ index2)))
  43           ((= index1 end1) nil)
  44         (declare (fixnum index1 index2))
  45         (if (char/= (schar string1 index1) (schar string2 index2))
  46             (return index1))))
  47      ((> len1 len2)
  48       (do ((index1 start1 (1+ index1))
  49            (index2 start2 (1+ index2)))
  50           ((= index2 end2) index1)
  51         (declare (fixnum index1 index2))
  52         (if (char/= (schar string1 index1) (schar string2 index2))
  53             (return index1))))
  54      (t
  55       (do ((index1 start1 (1+ index1))
  56            (index2 start2 (1+ index2)))
  57           ((= index1 end1) index1)
  58         (declare (fixnum index1 index2))
  59         (if (char/= (schar string1 index1) (schar string2 index2))
  60             (return index1)))))))
  61
  62 (defun %sp-reverse-string-compare (string1 start1 end1 string2 start2 end2)
  63   (declare (simple-string string1 string2))
  64   (declare (fixnum start1 end1 start2 end2))
  65   #!+sb-doc
  66   "like %SP-STRING-COMPARE, only backwards"
  67   (let ((len1 (- end1 start1))
  68         (len2 (- end2 start2)))
  69     (declare (fixnum len1 len2))
  70     (cond
  71      ((= len1 len2)
  72       (do ((index1 (1- end1) (1- index1))
  73            (index2 (1- end2) (1- index2)))
  74           ((< index1 start1) nil)
  75         (declare (fixnum index1 index2))
  76         (if (char/= (schar string1 index1) (schar string2 index2))
  77             (return index1))))
  78      ((> len1 len2)
  79       (do ((index1 (1- end1) (1- index1))
  80            (index2 (1- end2) (1- index2)))
  81           ((< index2 start2) index1)
  82         (declare (fixnum index1 index2))
  83         (if (char/= (schar string1 index1) (schar string2 index2))
  84             (return index1))))
  85      (t
  86       (do ((index1 (1- end1) (1- index1))
  87            (index2 (1- end2) (1- index2)))
  88           ((< index1 start1) index1)
  89         (declare (fixnum index1 index2))
  90         (if (char/= (schar string1 index1) (schar string2 index2))
  91             (return index1)))))))
  92
  93 (defmacro maybe-sap-maybe-string ((var) &body body)
  94   `(etypecase ,var
  95      (system-area-pointer
  96       (macrolet ((byte-ref (index)
  97                    `(sap-ref-8 ,',var ,index))
  98                  (char-ref (index)
  99                    `(code-char (byte-ref ,index))))
 100         ,@body))
 101      (simple-string
 102       (macrolet ((char-ref (index)
 103                    `(schar ,',var ,index))
 104                  (byte-ref (index)
 105                    `(char-code (char-ref ,index))))
 106         ,@body))))
 107
 108 (defun %sp-find-character-with-attribute (string start end table mask)
 109   (declare (type (simple-array (unsigned-byte 8) (256)) table)
 110            (type (or simple-string system-area-pointer) string)
 111            (fixnum start end mask))
 112   #!+sb-doc
 113   "%SP-Find-Character-With-Attribute  String, Start, End, Table, Mask
 114   The codes of the characters of String from Start to End are used as indices
 115   into the Table, which is a U-Vector of 8-bit bytes. When the number picked
 116   up from the table bitwise ANDed with Mask is non-zero, the current
 117   index into the String is returned. The corresponds to SCANC on the Vax."
 118   (maybe-sap-maybe-string (string)
 119     (do ((index start (1+ index)))
 120         ((>= index end) nil)
 121       (declare (fixnum index))
 122       (unless (zerop (logand (aref table (byte-ref index)) mask))
 123         (return index)))))
 124
 125 (defun %sp-reverse-find-character-with-attribute (string start end table mask)
 126   #!+sb-doc
 127   "Like %SP-Find-Character-With-Attribute, only sdrawkcaB."
 128   (declare (type (or simple-string system-area-pointer) string)
 129            (fixnum start end mask)
 130            (type (array (unsigned-byte 8) (256)) table))
 131   (maybe-sap-maybe-string (string)
 132     (do ((index (1- end) (1- index)))
 133         ((< index start) nil)
 134       (declare (fixnum index))
 135       (unless (zerop (logand (aref table (byte-ref index)) mask))
 136         (return index)))))
 137
 138 (defun %sp-find-character (string start end character)
 139   #!+sb-doc
 140   "%SP-Find-Character  String, Start, End, Character
 141   Searches String for the Character from Start to End. If the character is
 142   found, the corresponding index into String is returned, otherwise NIL is
 143   returned."
 144   (declare (fixnum start end)
 145            (type (or simple-string system-area-pointer) string)
 146            (base-char character))
 147   (maybe-sap-maybe-string (string)
 148     (do ((index start (1+ index)))
 149         ((>= index end) nil)
 150       (declare (fixnum index))
 151       (when (char= (char-ref index) character)
 152         (return index)))))
 153
 154 (defun %sp-reverse-find-character (string start end character)
 155   (declare (type (or simple-string system-area-pointer) string)
 156            (fixnum start end)
 157            (base-char character))
 158   #!+sb-doc
 159   "%SP-Reverse-Find-Character  String, Start, End, Character
 160   Searches String for Character from End to Start. If the character is
 161   found, the corresponding index into String is returned, otherwise NIL is
 162   returned."
 163   (maybe-sap-maybe-string (string)
 164     (do ((index (1- end) (1- index))
 165          (terminus (1- start)))
 166         ((= index terminus) nil)
 167       (declare (fixnum terminus index))
 168       (if (char= (char-ref index) character)
 169           (return index)))))
 170
 171 (defun %sp-skip-character (string start end character)
 172   (declare (type (or simple-string system-area-pointer) string)
 173            (fixnum start end)
 174            (base-char character))
 175   #!+sb-doc
 176   "%SP-Skip-Character  String, Start, End, Character
 177   Returns the index of the first character between Start and End which
 178   is not Char=  to Character, or NIL if there is no such character."
 179   (maybe-sap-maybe-string (string)
 180     (do ((index start (1+ index)))
 181         ((= index end) nil)
 182       (declare (fixnum index))
 183       (if (char/= (char-ref index) character)
 184           (return index)))))
 185
 186 (defun %sp-reverse-skip-character (string start end character)
 187   (declare (type (or simple-string system-area-pointer) string)
 188            (fixnum start end)
 189            (base-char character))
 190   #!+sb-doc
 191   "%SP-Skip-Character  String, Start, End, Character
 192   Returns the index of the last character between Start and End which
 193   is not Char=  to Character, or NIL if there is no such character."
 194   (maybe-sap-maybe-string (string)
 195     (do ((index (1- end) (1- index))
 196          (terminus (1- start)))
 197         ((= index terminus) nil)
 198       (declare (fixnum terminus index))
 199       (if (char/= (char-ref index) character)
 200           (return index)))))
 201
 202 (defun %sp-string-search (string1 start1 end1 string2 start2 end2)
 203   #!+sb-doc
 204   "%SP-String-Search  String1, Start1, End1, String2, Start2, End2
 205    Searches for the substring of String1 specified in String2.
 206    Returns an index into String2 or NIL if the substring wasn't
 207    found."
 208   (declare (simple-string string1 string2))
 209   (do ((index2 start2 (1+ index2)))
 210       ((= index2 end2) nil)
 211     (declare (fixnum index2))
 212     (when (do ((index1 start1 (1+ index1))
 213                (index2 index2 (1+ index2)))
 214               ((= index1 end1) t)
 215             (declare (fixnum index1 index2))
 216             (when (= index2 end2)
 217               (return-from %sp-string-search nil))
 218             (when (char/= (char string1 index1) (char string2 index2))
 219               (return nil)))
 220       (return index2))))