(FILECREATED " 8-SEP-81 23:33:48" <LISPUSERS>STRINGFNS.;13
 6668   

     changes to:  STRINGFNSCOMS

     previous date: " 2-FEB-81 14:32:29" <LISPUSERS>STRINGFNS.;12)


(PRETTYCOMPRINT STRINGFNSCOMS)

(RPAQQ STRINGFNSCOMS
 ((FNS DUMMYSTRING EOFP STRINGFROMFILE STRINGTOFILE UNBUFFER UCASESTRING)
		      (DECLARE: DONTCOPY EVAL@COMPILE DONTEVAL@LOAD (FILES (SYSLOAD FROM VALUEOF 
									     LISPUSERSDIRECTORIES)
									   CJSYS))))
(DEFINEQ

(DUMMYSTRING

  (LAMBDA NIL                                               (* lmm "19-OCT-78 23:27")

    (PROG ((X (CONSTANT (CONCAT))))
          (CLOSER (LOC X)
		  (IPLUS (CONSTANT (LLSH (ITIMES 512 5)
					 21))
			 (ITIMES 5 (LOC (MAPPAGE -1 262143)))))
          (RETURN X))))

(EOFP

  (LAMBDA (FILE)                                            (* lmm "18-OCT-78 16:02")

    (AND (NEQ (OR FILE (SETQ FILE (INPUT)))
	      T)
	 (BIT 4 (JS GDSTS (OPNJFN FILE (QUOTE INPUT))
		    0 0 2)))))

(STRINGFROMFILE

  (LAMBDA (FILE STRING)                                     (* lmm "18-OCT-78 16:17")

    (PROG ((FILE (INPUT (INPUT FILE)))
	   (I 1))                                           (* gets full file name, and errors if not open for 

							    input)

          (COND
	    ((EQ FILE T)
	      (PROG ((N (NCHARS STRING)))
		LP  (COND
		      ((NOT (IGREATERP I N))
			(SETQ STRING (RPLSTRING STRING I (READC FILE)))
			(SETQ I (ADD1 I))
			(GO LP)))))
	    (T (ASSEMBLE
 NIL
		         (CQ FILE)
		         (FASTCALL IFSET)
		         (CQ STRING)
		         (STN (QUOTE STPTT))
		         (JRST NOTERR)
		     STRERR
		         (CQ (SETQ STRING (CONCAT STRING)))
		     NOTERR
		         (FASTCALL UPATM)
		         (MOVEI 1 , 0 (3))
		         (STN (QUOTE PNAMT))
		         (JRST STRERR)
		         (HRRE 2 , FCHAR (FX))
		         (JUMPL 2 , NOCHR)
		         (IDPB 2 , 3)
		         (SOJLE 4 , OUT)
		     NOCHR
		         (HRRZ 1 , FILEN (FX))
		         (MOVE 2 , 3)
		         (MOVNI 3 , 0 (4))
		         (JS SIN)
		         (JFCL)
		         (JUMPE 3 , OUT)                    (* use up all the string?)

		         (MOVE 1 , 3)
		         (FASTCALL MKN)                     (* no- return shorter string)

		         (SETQ I)
		         (CQ (SETQ STRING (SUBSTRING STRING 1 (IPLUS (NCHARS STRING)
								     I))))
		     OUT))))
    STRING))

(STRINGTOFILE

  (LAMBDA (FILE STRING)                                     (* lmm "27-JUL-78 04:33")

    (PROG ((FILE (OUTPUT (OUTPUT FILE))))
          (COND
	    ((EQ FILE T)
	      (PRIN3 STRING FILE))
	    (T (ASSEMBLE
 NIL
		         (CQ (VAG (OPNJFN FILE)))
		         (PUSHN)
		         (CQ STRING)
		         (STN (QUOTE STPTT))
		         (JRST NOTERR)
		     STRERR
		         (CQ (SETQ STRING (MKSTRING STRING)))
		     NOTERR
		         (FASTCALL UPATM)
		         (POPN 1)
		         (MOVE 2 , 3)
		         (MOVNI 3 , 0 (4))
		         (JS SOUT)))))
    STRING))

(UNBUFFER

  (LAMBDA (FILE STRING)                                     (* lmm "19-NOV-78 15:37")

    (PROG ((FILE (INPUT (INPUT FILE))))
          (COND
	    ((EQ FILE T)
	      (PROG ((N (NCHARS STRING))
		     (I 0))
		LP  (COND
		      ((AND (READP FILE)
			    (ILESSP I N))
			(SETQ STRING (RPLSTRING STRING (SETQ I (ADD1 I))
						(READC FILE)))
			(GO LP))
		      ((NEQ I N)
			(SETQ STRING (SUBSTRING STRING 1 I))))))
	    (T (ASSEMBLE
 NIL
		         (CQ FILE)
		         (FASTCALL IFSET)                   (* get fileindex)

		         (PUSHN FX)
		         (CQ STRING)
		         (STN (QUOTE STPTT))
		         (JRST NOTERR)
		     STRERR
		         (CQ (SETQ STRING (CONCAT STRING)))
		     NOTERR
		         (FASTCALL UPATM)                   (* unpack string -

							    returns pointer in 3, length in 4)

		         (MOVEI 1 , 0 (3))
		         (STN (QUOTE PNAMT))                (* in atom-name-character space?)

		         (JRST STRERR)                      (* yes, copy string)

		         (POPN FX)                          (* get fileindex back)

		         (HRRZ 1 , FILEN (FX))              (* get JFN)

		         (SKIPN 5 , 4)                      (* save length)

		         (JRST OUT)                         (* empty string)

		         (HRRE 2 , FCHAR (FX))              (* check 1 char buffer)

		         (JUMPGE 2 , INSERT)                (* use the char)

		         (JRST ENDLP)
		     CHKSTS
		         (JS GTSTS)
		         (TLNE 2 , 1000Q)
		         (JRST IBE)
		         (MOVEI 2 , 0)
		         (JRST INSERT)
		     CR                                     (* get here if a CR is seen)

		         (JS BIN)                           (* get char after CR)

		         (CAIN 2 , 12Q)                     (* line-feed?)

		         (JRST LF)                          (* yes)

		         (JUMPG 4 , INSERT)                 (* if room, insert into string)

		         (MOVEM 2 , FCHAR (FX))             (* save away for next time)

		         (JRST OUT)
		     LF  (MOVEI 2 , 37Q)                    (* change CRLF to eol)

		         (DPB 2 , 3)
		         (JRST ENDLP)
		     LP  (JS BIN)
		         (JUMPE 2 , CHKSTS)
		     INSERT
		         (IDPB 2 , 3)
		         (SUBI 4 , 1)
		         (CAIN 2 , 15Q)
		         (JRST CR)
		     ENDLP
		         (JS SIBE)                          (* if buffer is empty)

		         (JUMPG 4 , LP)                     (* or string is exhausted)

		     IBE (JUMPE 4 , OUT)                    (* no more string)

		         (SUBI 5 , 0 (4))                   (* # chars read)

		         (MOVEI 1 , ASZ (5))                (* box it)

		         (SETQ FILE)
		         (CQ (SETQ STRING (SUBSTRING STRING 1 FILE)))
		     OUT))))
    STRING))

(UCASESTRING

  (LAMBDA (STRING)                                          (* lmm "18-OCT-78 16:25")

    (COND
      ((STRINGP STRING)                                     (* (RPLSTRING STRING 1 (U-CASE STRING)))

	(ASSEMBLE
 NIL
	          (CQ STRING)
	          (FASTCALL UPATM)
	          (JRST ENDLP)
	      LP  (ILDB 1 , 3)
	          (CAIL 1 , (CHCON1 "a"))
	          (CAILE 1 , (CHCON1 "z"))
	          (JRST ENDLP)
	          (SUBI 1 , (IDIFFERENCE (CHCON1 "a")
					 (CHCON1 "A")))
	          (DPB 1 , 3)
	      ENDLP
	          (SOJGE 4 , LP)
	          (CQ STRING))))))
)
(DECLARE: DONTCOPY EVAL@COMPILE DONTEVAL@LOAD 
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	   CJSYS)
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (461 6525 (DUMMYSTRING 473 . 768) (EOFP 772 . 994) (STRINGFROMFILE 998 . 2429) (
STRINGTOFILE 2433 . 3039) (UNBUFFER 3043 . 5909) (UCASESTRING 5913 . 6522)))))
STOP