home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / code / mipsstrops.lisp < prev    next >
Encoding:
Text File  |  1992-05-30  |  8.2 KB  |  220 lines
  1. ;;; -*- Log: Code.Log; Package: Lisp -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: mipsstrops.lisp,v 1.7 92/03/14 02:18:07 ram Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;;    String hacking functions that are stubs for things that might
  15. ;;; be microcoded someday.
  16. ;;;
  17. ;;;    Written by Rob MacLachlan and Skef Wholey
  18. ;;;
  19. (in-package "SYSTEM")
  20. (export '(%sp-reverse-find-character-with-attribute))
  21.  
  22. (in-package "LISP")
  23.  
  24. ;(defun %sp-byte-blt (src-string src-start dst-string dst-start dst-end)
  25. ;  "Moves bytes from Src-String into Dst-String between Dst-Start (inclusive)
  26. ;and Dst-End (exclusive) (Dst-Start - Dst-End bytes are moved).  Overlap of the
  27. ;strings does not affect the result.  This would be done on the Vax
  28. ;with MOVC3. The arguments do not need to be strings: 8-bit U-Vectors
  29. ;are also acceptable."
  30. ;  (%primitive byte-blt src-string src-start dst-string dst-start dst-end))
  31.  
  32. (defun %sp-string-compare (string1 start1 end1 string2 start2 end2)
  33.   (declare (simple-string string1 string2))
  34.   (declare (fixnum start1 end1 start2 end2))
  35.   "Compares the substrings specified by String1 and String2 and returns
  36. NIL if the strings are String=, or the lowest index of String1 in
  37. which the two differ. If one string is longer than the other and the
  38. shorter is a prefix of the longer, the length of the shorter + start1 is
  39. returned. This would be done on the Vax with CMPC3. The arguments must
  40. be simple strings."
  41.   (let ((len1 (- end1 start1))
  42.     (len2 (- end2 start2)))
  43.     (declare (fixnum len1 len2))
  44.     (cond
  45.      ((= len1 len2)
  46.       (do ((index1 start1 (1+ index1))
  47.        (index2 start2 (1+ index2)))
  48.       ((= index1 end1) nil)
  49.     (declare (fixnum index1 index2))
  50.     (if (char/= (schar string1 index1) (schar string2 index2))
  51.         (return index1))))
  52.      ((> len1 len2)
  53.       (do ((index1 start1 (1+ index1))
  54.        (index2 start2 (1+ index2)))
  55.       ((= index2 end2) index1)
  56.     (declare (fixnum index1 index2))
  57.     (if (char/= (schar string1 index1) (schar string2 index2))
  58.         (return index1))))
  59.      (t
  60.       (do ((index1 start1 (1+ index1))
  61.        (index2 start2 (1+ index2)))
  62.       ((= index1 end1) index1)
  63.     (declare (fixnum index1 index2))
  64.     (if (char/= (schar string1 index1) (schar string2 index2))
  65.         (return index1)))))))
  66.  
  67. (defun %sp-reverse-string-compare (string1 start1 end1 string2 start2 end2)
  68.   (declare (simple-string string1 string2))
  69.   (declare (fixnum start1 end1 start2 end2))
  70.   "Like %sp-string-compare, only backwards."
  71.   (let ((len1 (- end1 start1))
  72.     (len2 (- end2 start2)))
  73.     (declare (fixnum len1 len2))
  74.     (cond
  75.      ((= len1 len2)
  76.       (do ((index1 (1- end1) (1- index1))
  77.        (index2 (1- end2) (1- index2)))
  78.       ((< index1 start1) nil)
  79.     (declare (fixnum index1 index2))
  80.     (if (char/= (schar string1 index1) (schar string2 index2))
  81.         (return index1))))
  82.      ((> len1 len2)
  83.       (do ((index1 (1- end1) (1- index1))
  84.        (index2 (1- end2) (1- index2)))
  85.       ((< index2 start2) index1)
  86.     (declare (fixnum index1 index2))
  87.     (if (char/= (schar string1 index1) (schar string2 index2))
  88.         (return index1))))
  89.      (t
  90.       (do ((index1 (1- end1) (1- index1))
  91.        (index2 (1- end2) (1- index2)))
  92.       ((< index1 start1) index1)
  93.     (declare (fixnum index1 index2))
  94.     (if (char/= (schar string1 index1) (schar string2 index2))
  95.         (return index1)))))))
  96.  
  97. (defmacro maybe-sap-maybe-string ((var) &body body)
  98.   `(etypecase ,var
  99.      (system-area-pointer
  100.       (macrolet ((byte-ref (index)
  101.            `(sap-ref-8 ,',var ,index))
  102.          (char-ref (index)
  103.            `(code-char (byte-ref ,index))))
  104.     ,@body))
  105.      (simple-string
  106.       (macrolet ((char-ref (index)
  107.            `(schar ,',var ,index))
  108.          (byte-ref (index)
  109.            `(char-code (char-ref ,index))))
  110.     ,@body))))
  111.  
  112. (defun %sp-find-character-with-attribute (string start end table mask)
  113.   (declare (type (simple-array (unsigned-byte 8) (256)) table)
  114.        (type (or simple-string system-area-pointer) string)
  115.        (fixnum start end mask))
  116.   "%SP-Find-Character-With-Attribute  String, Start, End, Table, Mask
  117.   The codes of the characters of String from Start to End are used as indices
  118.   into the Table, which is a U-Vector of 8-bit bytes. When the number picked
  119.   up from the table bitwise ANDed with Mask is non-zero, the current
  120.   index into the String is returned. The corresponds to SCANC on the Vax."
  121.   (maybe-sap-maybe-string (string)
  122.     (do ((index start (1+ index)))
  123.     ((>= index end) nil)
  124.       (declare (fixnum index))
  125.       (unless (zerop (logand (aref table (byte-ref index)) mask))
  126.     (return index)))))
  127.  
  128. (defun %sp-reverse-find-character-with-attribute (string start end table mask)
  129.   "Like %SP-Find-Character-With-Attribute, only sdrawkcaB."
  130.   (declare (type (or simple-string system-area-pointer) string)
  131.        (fixnum start end mask)
  132.        (type (array (unsigned-byte 8) (256)) table))
  133.   (maybe-sap-maybe-string (string)
  134.     (do ((index (1- end) (1- index)))
  135.     ((< index start) nil)
  136.       (declare (fixnum index))
  137.       (unless (zerop (logand (aref table (byte-ref index)) mask))
  138.     (return index)))))
  139.  
  140. (defun %sp-find-character (string start end character)
  141.   "%SP-Find-Character  String, Start, End, Character
  142.   Searches String for the Character from Start to End.  If the character is
  143.   found, the corresponding index into String is returned, otherwise NIL is
  144.   returned."
  145.   (declare (fixnum start end)
  146.        (type (or simple-string system-area-pointer) string)
  147.        (base-char character))
  148.   (maybe-sap-maybe-string (string)
  149.     (do ((index start (1+ index)))
  150.     ((>= index end) nil)
  151.       (declare (fixnum index))
  152.       (when (char= (char-ref index) character)
  153.     (return index)))))
  154.  
  155. (defun %sp-reverse-find-character (string start end character)
  156.   (declare (type (or simple-string system-area-pointer) string)
  157.        (fixnum start end)
  158.        (base-char character))
  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.   "%SP-Skip-Character  String, Start, End, Character
  176.   Returns the index of the first character between Start and End which
  177.   is not Char=  to Character, or NIL if there is no such character."
  178.   (maybe-sap-maybe-string (string)
  179.     (do ((index start (1+ index)))
  180.     ((= index end) nil)
  181.       (declare (fixnum index))
  182.       (if (char/= (char-ref index) character)
  183.       (return index)))))
  184.  
  185. (defun %sp-reverse-skip-character (string start end character)
  186.   (declare (type (or simple-string system-area-pointer) string)
  187.        (fixnum start end)
  188.        (base-char character))
  189.   "%SP-Skip-Character  String, Start, End, Character
  190.   Returns the index of the last character between Start and End which
  191.   is not Char=  to Character, or NIL if there is no such character."
  192.   (maybe-sap-maybe-string (string)
  193.     (do ((index (1- end) (1- index))
  194.      (terminus (1- start)))
  195.     ((= index terminus) nil)
  196.       (declare (fixnum terminus index))
  197.       (if (char/= (char-ref index) character)
  198.       (return index)))))
  199.  
  200. (defun %sp-string-search (string1 start1 end1 string2 start2 end2)
  201.   "%SP-String-Search  String1, Start1, End1, String2, Start2, End2
  202.    Searches for the substring of String1 specified in String2.
  203.    Returns an index into String2 or NIL if the substring wasn't
  204.    found."
  205.   (declare (simple-string string1 string2))
  206.   (do ((index2 start2 (1+ index2)))
  207.       ((= index2 end2) nil)
  208.     (declare (fixnum index2))
  209.     (when (do ((index1 start1 (1+ index1))
  210.            (index2 index2 (1+ index2)))
  211.           ((= index1 end1) t)
  212.         (declare (fixnum index1 index2))
  213.         (when (= index2 end2)
  214.           (return-from %sp-string-search nil))
  215.         (when (char/= (char string1 index1) (char string2 index2))
  216.           (return nil)))
  217.       (return index2))))
  218.  
  219.  
  220.