;;; the shorter is a prefix of the longer, the length of the shorter +
;;; START1 is returned. The arguments must be simple strings.
;;;
-;;; This would be done on the Vax with CMPC3.
+;;; This would be done on the Vax with CMPC3.
(defun %sp-string-compare (string1 start1 end1 string2 start2 end2)
(declare (simple-string string1 string2))
(declare (fixnum start1 end1 start2 end2))
(let ((len1 (- end1 start1))
- (len2 (- end2 start2)))
+ (len2 (- end2 start2)))
(declare (fixnum len1 len2))
(cond
((= len1 len2)
(do ((index1 start1 (1+ index1))
- (index2 start2 (1+ index2)))
- ((= index1 end1) nil)
- (declare (fixnum index1 index2))
- (if (char/= (schar string1 index1) (schar string2 index2))
- (return index1))))
+ (index2 start2 (1+ index2)))
+ ((= index1 end1) nil)
+ (declare (fixnum index1 index2))
+ (if (char/= (schar string1 index1) (schar string2 index2))
+ (return index1))))
((> len1 len2)
(do ((index1 start1 (1+ index1))
- (index2 start2 (1+ index2)))
- ((= index2 end2) index1)
- (declare (fixnum index1 index2))
- (if (char/= (schar string1 index1) (schar string2 index2))
- (return index1))))
+ (index2 start2 (1+ index2)))
+ ((= index2 end2) index1)
+ (declare (fixnum index1 index2))
+ (if (char/= (schar string1 index1) (schar string2 index2))
+ (return index1))))
(t
(do ((index1 start1 (1+ index1))
- (index2 start2 (1+ index2)))
- ((= index1 end1) index1)
- (declare (fixnum index1 index2))
- (if (char/= (schar string1 index1) (schar string2 index2))
- (return index1)))))))
+ (index2 start2 (1+ index2)))
+ ((= index1 end1) index1)
+ (declare (fixnum index1 index2))
+ (if (char/= (schar string1 index1) (schar string2 index2))
+ (return index1)))))))
;;; like %SP-STRING-COMPARE, only backwards
(defun %sp-reverse-string-compare (string1 start1 end1 string2 start2 end2)
(declare (simple-string string1 string2))
(declare (fixnum start1 end1 start2 end2))
(let ((len1 (- end1 start1))
- (len2 (- end2 start2)))
+ (len2 (- end2 start2)))
(declare (fixnum len1 len2))
(cond
((= len1 len2)
(do ((index1 (1- end1) (1- index1))
- (index2 (1- end2) (1- index2)))
- ((< index1 start1) nil)
- (declare (fixnum index1 index2))
- (if (char/= (schar string1 index1) (schar string2 index2))
- (return index1))))
+ (index2 (1- end2) (1- index2)))
+ ((< index1 start1) nil)
+ (declare (fixnum index1 index2))
+ (if (char/= (schar string1 index1) (schar string2 index2))
+ (return index1))))
((> len1 len2)
(do ((index1 (1- end1) (1- index1))
- (index2 (1- end2) (1- index2)))
- ((< index2 start2) index1)
- (declare (fixnum index1 index2))
- (if (char/= (schar string1 index1) (schar string2 index2))
- (return index1))))
+ (index2 (1- end2) (1- index2)))
+ ((< index2 start2) index1)
+ (declare (fixnum index1 index2))
+ (if (char/= (schar string1 index1) (schar string2 index2))
+ (return index1))))
(t
(do ((index1 (1- end1) (1- index1))
- (index2 (1- end2) (1- index2)))
- ((< index1 start1) index1)
- (declare (fixnum index1 index2))
- (if (char/= (schar string1 index1) (schar string2 index2))
- (return index1)))))))
-
-(defmacro maybe-sap-maybe-string ((var) &body body)
- `(etypecase ,var
- (system-area-pointer
- (macrolet ((byte-ref (index)
- `(sap-ref-8 ,',var ,index))
- (char-ref (index)
- `(code-char (byte-ref ,index))))
- ,@body))
- (simple-string
- (macrolet ((char-ref (index)
- `(schar ,',var ,index))
- (byte-ref (index)
- `(char-code (char-ref ,index))))
- ,@body))))
-
-;;; The codes of the characters of STRING from START to END are used
-;;; as indices into the TABLE, which is a U-Vector of 8-bit bytes.
-;;; When the number picked up from the table bitwise ANDed with MASK
-;;; is non-zero, the current index into the STRING is returned.
-;;;
-;;; (This corresponds to SCANC on the Vax.)
-(defun %sp-find-character-with-attribute (string start end table mask)
- (declare (type (simple-array (unsigned-byte 8) (256)) table)
- (type (or simple-string system-area-pointer) string)
- (fixnum start end mask))
- (maybe-sap-maybe-string (string)
- (do ((index start (1+ index)))
- ((>= index end) nil)
- (declare (fixnum index))
- (unless (zerop (logand (aref table (byte-ref index)) mask))
- (return index)))))
-
-;;; like %SP-FIND-CHARACTER-WITH-ATTRIBUTE, only sdrawkcaB
-(defun %sp-reverse-find-character-with-attribute (string start end table mask)
- (declare (type (or simple-string system-area-pointer) string)
- (fixnum start end mask)
- (type (array (unsigned-byte 8) (256)) table))
- (maybe-sap-maybe-string (string)
- (do ((index (1- end) (1- index)))
- ((< index start) nil)
- (declare (fixnum index))
- (unless (zerop (logand (aref table (byte-ref index)) mask))
- (return index)))))
-
-;;; Search STRING for the CHARACTER from START to END. If the
-;;; character is found, the corresponding index into STRING is
-;;; returned, otherwise NIL is returned.
-(defun %sp-find-character (string start end character)
- (declare (fixnum start end)
- (type (or simple-string system-area-pointer) string)
- (base-char character))
- (maybe-sap-maybe-string (string)
- (do ((index start (1+ index)))
- ((>= index end) nil)
- (declare (fixnum index))
- (when (char= (char-ref index) character)
- (return index)))))
-
-;;; Search STRING for CHARACTER from END to START. If the character is
-;;; found, the corresponding index into STRING is returned, otherwise
-;;; NIL is returned.
-(defun %sp-reverse-find-character (string start end character)
- (declare (type (or simple-string system-area-pointer) string)
- (fixnum start end)
- (base-char character))
- (maybe-sap-maybe-string (string)
- (do ((index (1- end) (1- index))
- (terminus (1- start)))
- ((= index terminus) nil)
- (declare (fixnum terminus index))
- (if (char= (char-ref index) character)
- (return index)))))
-
-;;; Return the index of the first character between START and END
-;;; which is not CHAR= to CHARACTER, or NIL if there is no such
-;;; character.
-(defun %sp-skip-character (string start end character)
- (declare (type (or simple-string system-area-pointer) string)
- (fixnum start end)
- (base-char character))
- (maybe-sap-maybe-string (string)
- (do ((index start (1+ index)))
- ((= index end) nil)
- (declare (fixnum index))
- (if (char/= (char-ref index) character)
- (return index)))))
-
-;;; Return the index of the last character between START and END which
-;;; is not CHAR= to CHARACTER, or NIL if there is no such character.
-(defun %sp-reverse-skip-character (string start end character)
- (declare (type (or simple-string system-area-pointer) string)
- (fixnum start end)
- (base-char character))
- (maybe-sap-maybe-string (string)
- (do ((index (1- end) (1- index))
- (terminus (1- start)))
- ((= index terminus) nil)
- (declare (fixnum terminus index))
- (if (char/= (char-ref index) character)
- (return index)))))
-
-;;; Search for the substring of STRING1 specified in STRING2. Return
-;;; an index into STRING2, or NIL if the substring wasn't found.
-(defun %sp-string-search (string1 start1 end1 string2 start2 end2)
- (declare (simple-string string1 string2))
- (do ((index2 start2 (1+ index2)))
- ((= index2 end2) nil)
- (declare (fixnum index2))
- (when (do ((index1 start1 (1+ index1))
- (index2 index2 (1+ index2)))
- ((= index1 end1) t)
- (declare (fixnum index1 index2))
- (when (= index2 end2)
- (return-from %sp-string-search nil))
- (when (char/= (char string1 index1) (char string2 index2))
- (return nil)))
- (return index2))))
+ (index2 (1- end2) (1- index2)))
+ ((< index1 start1) index1)
+ (declare (fixnum index1 index2))
+ (if (char/= (schar string1 index1) (schar string2 index2))
+ (return index1)))))))
projects / sbcl.git / blobdiff