(FILECREATED "12-Mar-84 20:29:21" {PHYLUM}<LISP>LIBRARY>BSEARCH.;7
 11482  

      changes to:  (FNS STRPOS)

      previous date: " 9-Mar-84 19:17:19" {PHYLUM}<LISP>LIBRARY>BSEARCH.;6)


(* Copyright (c) 1983, 1984 by Xerox Corporation)

(PRETTYCOMPRINT BSEARCHCOMS)

(RPAQQ BSEARCHCOMS
 ((FNS STRPOS STRPOSL BFILEPOS)
		    (GLOBALRESOURCES (\STRPOSLARRAY (NCREATE (QUOTE CHARTABLE))))
		    (VARS \BFILEPOS.SHORTPATTERNL)
		    (DECLARE: DONTEVAL@LOAD DOCOPY (P (MOVD? (QUOTE STRPOS)
							     (QUOTE BSTRPOS))
						      (MOVD? (QUOTE STRPOSL)
							     (QUOTE BSTRPOSL))))))
(DEFINEQ

(STRPOS

  (LAMBDA (PAT STRING START SKIP ANCHOR TAIL CASEARRAY BACKWARDSFLG)
                                                             (* JonL "12-Mar-84 20:26")

    (DECLARE
 (GLOBALVARS \TRANSPARENT))
    (PROG (PATLEN PATBASE PATOFFST STRINGLEN STRINGBASE STRINGOFFST MAXI JMAX 1stPATchar jthPATchar)
          (if
 (LITATOM PAT)
	      then
 (SETQ PATBASE (fetch
 (LITATOM PNAMEBASE) of
 PAT))
		   (SETQ PATOFFST 1)
		   (SETQ PATLEN (fetch
 (LITATOM PNAMELENGTH) of
 PAT))
	    else
 (OR (STRINGP PAT)
		     (SETQ PAT (MKSTRING PAT)))
		 (SETQ PATBASE (fetch
 (STRINGP BASE) of
 PAT))
		 (SETQ PATOFFST (fetch
 (STRINGP OFFST) of
 PAT))
		 (SETQ PATLEN (fetch
 (STRINGP LENGTH) of
 PAT)))
          (if
 (LITATOM STRING)
	      then
 (SETQ STRINGBASE (fetch
 (LITATOM PNAMEBASE) of
 STRING))
		   (SETQ STRINGOFFST 1)
		   (SETQ STRINGLEN (fetch
 (LITATOM PNAMELENGTH) of
 STRING))
	    else
 (OR (STRINGP STRING)
		     (SETQ STRING (MKSTRING STRING)))
		 (SETQ STRINGBASE (fetch
 (STRINGP BASE) of
 STRING))
		 (SETQ STRINGOFFST (fetch
 (STRINGP OFFST) of
 STRING))
		 (SETQ STRINGLEN (fetch
 (STRINGP LENGTH) of
 STRING)))
          (if
 (IGEQ 0 (SETQ MAXI (ADD1 (IDIFFERENCE STRINGLEN PATLEN))))
	      then
                                           (* Who's he kidding? The PATTERN length is greater than 

							     the STRING length)

		   (RETURN))
          (if
 (NULL START)
	      then
 (SETQ START (if
 BACKWARDSFLG
				   then
 MAXI
				 else
 1))
	    elseif
 (ILESSP START 0)
	      then
 (add
 START (ADD1 STRINGLEN))
		   (if
 (ILESSP START 1)
		       then
 (RETURN))
	    elseif
 (IGREATERP START MAXI)
	      then
 (RETURN))                                 (* Normalize start to a 1-origin index between 1 and 

							     LEN)

          (if
 (ILEQ PATLEN 0)
	      then
 (RETURN START))                           (* Null pattern matches anything)

          (AND SKIP (SETQ SKIP (CHCON1 SKIP)))
          (if
 (NULL CASEARRAY)
	      then
 (SETQ CASEARRAY \TRANSPARENT)
	    elseif
 (NOT (AND (ARRAYP CASEARRAY)
			     (EQ \ST.BYTE (fetch
 (ARRAYP TYP) of
 CASEARRAY))
			     (EQ (CONSTANT (EXPT 2 BITSPERBYTE))
				 (fetch
 (ARRAYP LENGTH) of
 CASEARRAY))))
	      then
 (\ILLEGAL.ARG CASEARRAY))                 (* Oh, for a LET here!)

          (add
 STRINGOFFST -1)
          (add
 PATOFFST -1)
          (RETURN (PROG ((CAOFFST (fetch
 (ARRAYP OFFST) of
 CASEARRAY))
			 (CABASE (fetch
 (ARRAYP BASE) of
 CASEARRAY))
			 (OFFST.I (IPLUS STRINGOFFST START (if
 BACKWARDSFLG
							       then
 1
							     else
 -1)))
			 (LASTI (IPLUS STRINGOFFST
				       (if
 ANCHOR
					   then
 START
					 elseif
 BACKWARDSFLG
					   then
 1
					 else
 MAXI)))
			 (JSTART (IPLUS PATOFFST 2))
			 (JMAX (IPLUS PATOFFST PATLEN)))     (* Remember! START is a 1-origin index)

                                                             (* There will be at least one pass thru the following 

							     loop, or else we would have (RETURN) before now)

		        (OR (ZEROP CAOFFST)
			    (SHOULDNT "NonZero OFFST for a CASEARRAY?"))
		        (SETQ 1stPATchar (\GETBASEBYTE CABASE (\GETBASEBYTE PATBASE (ADD1 PATOFFST))))
		    LP  (if
 (if
 BACKWARDSFLG
				then
 (ILESSP (add
 OFFST.I -1)
					     LASTI)
			      else
 (IGREATERP (add
 OFFST.I 1)
					      LASTI))
			    then
 (RETURN)
			  elseif
 (AND (OR (EQ 1stPATchar SKIP)
					  (EQ 1stPATchar (\GETBASEBYTE CABASE (\GETBASEBYTE 
										       STRINGBASE 
											  OFFST.I))))
				      (for
 J from
 JSTART to
 JMAX as
 K from
 (ADD1 OFFST.I)
					 always
 (OR (EQ SKIP (SETQ jthPATchar
							  (\GETBASEBYTE CABASE (\GETBASEBYTE PATBASE 
											     J))))
						    (EQ jthPATchar (\GETBASEBYTE CABASE
										 (\GETBASEBYTE 
										       STRINGBASE K)))
						    )))
			    then
 (RETURN (IDIFFERENCE (if
 TAIL
							  then
 (IPLUS OFFST.I PATLEN)
							else
 OFFST.I)
						      STRINGOFFST)))
		        (GO LP)                              (* Fall out thru bottom if didn't find it)

		    )))))

(STRPOSL

  (LAMBDA (A STRING START NEG CASEARRAY BACKWARDSFLG)        (* JonL " 8-Mar-84 14:33")

    (GLOBALRESOURCE \STRPOSLARRAY (PROG (BASE OFFST LEN I LASTI)
				        (OR (type?
 CHARTABLE A)
					    (SETQ A (MAKEBITTABLE A NIL \STRPOSLARRAY)))
				        (if
 (LITATOM STRING)
					    then
 (SETQ BASE (fetch
 (LITATOM PNAMEBASE) of
 STRING))
						 (SETQ LEN (fetch
 (LITATOM PNAMELENGTH) of
 STRING))
						 (SETQ OFFST 1)
					  else
 (OR (STRINGP STRING)
						   (SETQ STRING (MKSTRING STRING)))
					       (SETQ BASE (fetch
 (STRINGP BASE) of
 STRING))
					       (SETQ LEN (fetch
 (STRINGP LENGTH) of
 STRING))
					       (SETQ OFFST (fetch
 (STRINGP OFFST) of
 STRING)))
				        (if
 (NULL START)
					    then
 (SETQ START (if
 BACKWARDSFLG
								 then
 LEN
							       else
 1))
					  elseif
 (ILESSP START 0)
					    then
 (add
 START (ADD1 LEN))
						 (if
 (ILESSP START 1)
						     then
 (RETURN))
					  elseif
 (IGREATERP START LEN)
					    then
 (RETURN))   (* Normalize start to a 1-origin index between 1 and 

							     LEN)

				        (add
 OFFST -1)       (* Bias the OFFST since START is 1-origin and the loop 

							     deals in 0-origin)

				        (SETQ NEG (if
 NEG
						      then
 
                                                             (* Convert NEG to match the correct value returned by 

							     \SYNCODE)

							   0
						    else
 1))
				        (if
 (NULL CASEARRAY)
					    then
 (SETQ CASEARRAY \TRANSPARENT)
					  elseif
 (NOT (AND (ARRAYP CASEARRAY)
							   (EQ \ST.BYTE (fetch
 (ARRAYP TYP)
									   of
 CASEARRAY))
							   (EQ (CONSTANT (EXPT 2 BITSPERBYTE))
							       (fetch
 (ARRAYP LENGTH) of
 CASEARRAY))))
					    then
 (\ILLEGAL.ARG CASEARRAY))
				        (SETQ I (IPLUS OFFST START))
				        (SETQ LASTI (IPLUS OFFST (if
 BACKWARDSFLG
								     then
 (add
 I 1)
									  1
								   else
 (add
 I -1)
									LEN)))
				        (OR (ZEROP (fetch
 (ARRAYP OFFST) of
 CASEARRAY))
					    (SHOULDNT "NonZero OFFST for CASEARRAY?"))
				        (SETQ CASEARRAY (fetch
 (ARRAYP BASE) of
 CASEARRAY))
                                                             (* There will be at least one pass thru the following 

							     loop, or else we would have (RETURN) before now)

				    LP  (if
 (if
 BACKWARDSFLG
						then
 (ILESSP (add
 I -1)
							     LASTI)
					      else
 (IGREATERP (add
 I 1)
							      LASTI))
					    then
 (RETURN)
					  elseif
 (EQ NEG (\SYNCODE A (\GETBASEBYTE CASEARRAY
										   (\GETBASEBYTE
										     BASE I))))
					    then
 (RETURN (IDIFFERENCE I OFFST)))
				        (GO LP)))))

(BFILEPOS

  (LAMBDA (PATTERN FILE LOWINDEX HIGHINDEX SKIP TAIL CASEARRAY)
                                                             (* JonL " 1-Jan-84 02:34")

    (OR (STRINGP PATTERN)
	(LITATOM PATTERN)
	(SETQ PATTERN (MKSTRING PATTERN)))
    (RESETLST (PROG ((PLEN (NCHARS PATTERN))
		     (INCREMENT 128)
		     (FF (FUNCTION FILEPOS))
		     (OFPOS 0)
		     ORIGINALLYOPENP FLEN QUARTERFLEN STARTI NEXTI MAXI TEM STRM)
		    (if
 (SETQ TEM (OPENP FILE))
			then
 (SETQ ORIGINALLYOPENP T)
			     (SETQ STRM (\GETSTREAM TEM))
		      else
 (RESETSAVE (SETQ STRM (OPENSTREAM FILE (QUOTE INPUT)))
				      (QUOTE (PROGN (CLOSEF? OLDVALUE)))))
		    (SETQ FLEN (GETFILEINFO STRM (QUOTE LENGTH)))
		    (if
 (IGREATERP 0 (SETQ MAXI (IDIFFERENCE FLEN PLEN)))
			then
                                 (* Who's he kidding? The PATTERN length is greater than 

							     the file length)

			     (RETURN))
		    (SETQ QUARTERFLEN (IMAX 2 (LRSH FLEN 2)))
		    (SETQ OFPOS (GETFILEPTR STRM))
		    (if
 (NULL LOWINDEX)
			then
 (SETQ LOWINDEX OFPOS)
		      elseif
 (ILESSP LOWINDEX 0)
			then
 (add
 LOWINDEX (ADD1 MAXI))
			     (if
 (ILESSP LOWINDEX 0)
				 then
 (SETQ LOWINDEX 0))
		      elseif
 (IGREATERP LOWINDEX MAXI)
			then
 (RETURN))                       (* Note that LOWINDEX really means low-end limit for 

							     search)

		    (if
 (NULL HIGHINDEX)
			then
 (SETQ HIGHINDEX MAX.FIXP)
		      elseif
 (ILESSP HIGHINDEX 0)
			then
 (add
 HIGHINDEX (ADD1 MAXI)))
		    (SETQ HIGHINDEX (IMIN HIGHINDEX MAXI))
		    (if
 (ILESSP HIGHINDEX LOWINDEX)
			then
 (ERROR "High-end index less than low-end"))
		    (if
 ORIGINALLYOPENP
			then
 (RESETSAVE (LIST STRM OFPOS)
					(QUOTE (AND RESETSTATE (APPLY (QUOTE SETFILEPTR)
								      OLDVALUE)))))
		    (SETQ NEXTI)
		    (SETQ STARTI (ADD1 HIGHINDEX))
		    (SETQ TAIL (if
 TAIL
				   then
 PLEN
				 else
 0))
		FINDFIRST
		    (if
 NEXTI
			then
 (SETQ STARTI NEXTI)
		      elseif
 (ILEQ STARTI LOWINDEX)
			then
                                 (* Looks like we never found any instance of the 

							     PATTERN)

			     (RETURN)
		      else
 (SETQ MAXI (SUB1 STARTI))
			   (SETQ STARTI (IMAX (PROG1 LOWINDEX 
                                                             (* Comment PPLossage)
)
					      (IDIFFERENCE STARTI (if
 (ILESSP INCREMENT QUARTERFLEN)
								      then
 (PROG1 INCREMENT
										  (SETQ INCREMENT
										    (LLSH INCREMENT 1)
										    ))
								    else
 QUARTERFLEN))))
			   (SETQ NEXTI (FFILEPOS PATTERN STRM STARTI MAXI SKIP NIL CASEARRAY))
			   (GO FINDFIRST))
		NARROWDOWN                                   (* At this point, we have one instance found at STARTI 

							     and certification that none occur at or beyond MAXI)

		    (SETQ NEXTI (IPLUS STARTI (LRSH (IDIFFERENCE MAXI STARTI)
						    1)))
		    (if
 (IEQP NEXTI STARTI)
			then
 (RETURN (IPLUS STARTI TAIL)))
		    (if
 (SETQ TEM (FFILEPOS PATTERN STRM NEXTI MAXI SKIP NIL CASEARRAY))
			then
 (SETQ STARTI TEM)
		      else
 (SETQ MAXI NEXTI))
		    (GO NARROWDOWN)))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(PUTDEF (QUOTE \STRPOSLARRAY)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (NCREATE (QUOTE CHARTABLE))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \STRPOSLARRAY)
)

(RPAQQ \STRPOSLARRAY
 NIL)

(RPAQQ \BFILEPOS.SHORTPATTERNL
 16)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(MOVD? (QUOTE STRPOS)
       (QUOTE BSTRPOS))
(MOVD? (QUOTE STRPOSL)
       (QUOTE BSTRPOSL))
)
(PUTPROPS BSEARCH COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (591 10997 (STRPOS 601 . 4913) (STRPOSL 4915 . 7768) (BFILEPOS 7770 . 10995)))))
STOP