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)))))))