X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fmipsstrops.lisp;h=42708c6279fe8bd0bb453e94283f76f9e261a723;hb=23c0c48f562d7dc5d1615bf13cb831b46c91d106;hp=c2798d1f37c901a70660b10741120e8c7c90d7df;hpb=0b3ec4b1d978b887db175b7b3bada8e727683e15;p=sbcl.git diff --git a/src/code/mipsstrops.lisp b/src/code/mipsstrops.lisp index c2798d1..42708c6 100644 --- a/src/code/mipsstrops.lisp +++ b/src/code/mipsstrops.lisp @@ -18,180 +18,62 @@ ;;; 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)))))))