(FILECREATED "26-SEP-78 19:34:04" <LISPUSERS>FORKWAITFORINPUT.;3
 10536Q 

     changes to:  WAITFORINPUT

     previous date: "26-SEP-78 14:43:30" <LISPUSERS>FORKWAITFORINPUT.;2)


(PRETTYCOMPRINT FORKWAITFORINPUTCOMS)

(RPAQQ FORKWAITFORINPUTCOMS
 ((DECLARE: FIRST (ADDVARS (NOSWAPFNS REUSEFORK)))
			     (FNS WAITFORINPUT REUSEFORK)
			     (VARS (WAITFORK))
			     (LOCALVARS . T)
			     (GLOBALVARS WAITFORK USERFORKS)))
(DECLARE: FIRST 

(ADDTOVAR NOSWAPFNS
 REUSEFORK)
)
(DEFINEQ

(WAITFORINPUT

  (LAMBDA (FILE)                                            (* lmm "26-SEP-78 18:57")

                                                            (* wait for input from FILE or T -

							    if FILE is # then rather than waiting for file, wait for

							    # seconds)

    (PROG NIL
          (AND (READP T)
	       (RETURN T))
          (COND
	    ((NUMBERP FILE))
	    ((READP (SETQ FILE (COND
			((NULL FILE)
			  (INPUT))
			((OPENP FILE (QUOTE INPUT)))
			(T (ERRORX (LIST 15Q FILE))))))
	      (RETURN FILE)))
          (COND
	    ((EQ FILE T)
	      (RETURN (PROGN (PEEKC T)
			     T))))                          (* wait until some char is available)

          (SETQ WAITFORK (REUSEFORK
 WAITFORK))
          (RETURN (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (FILE FORK)
						     (PROG NIL
						           (SELECTQ (CAR (RFSTS FORK))
								    (2)
								    (777777777777Q (RETURN))
								    (ASSEMBLE
 NIL
									      (CV FORK)
									      (JS HFORK)))
						           (AND FILE (NOT (NUMBERP FILE))
								(ASSEMBLE
 NIL
								          (CV FORK)
								          (MOVEI 2 , 777000Q)
								          (JS RFACS)
								          (CQ FILE)
								          (FASTCALL IFSET)
								          (HRRZ 1 , 777003Q)
								          (HRRM 1 , FCHAR (FX)))))))
						 FILE WAITFORK))
			    (NOT (ZEROP (ASSEMBLE
 NIL
					          (CQ (COND
							((NOT (NUMBERP FILE))
							  (GO WAITFORBIN))))
					          (CV FILE)
					          (MOVEM 1 , DC1)
					          (CV WAITFORK)
					          (MOVEI 2 , DCS)
					          (JRST STARTIT)
					      DCS (JUMP 0)
					      DC1 (JUMP 1)
					      DC2 (JUMP 2)
					      DC3 (JUMP 3)
					      DC4 (JS DISMS)
					      DC5 (MOVEI 1 , 100Q)
					          (MOVEI 2 , 0)
					          (JS STI)
					          (JS HALTF)
					          (JS HALTF)
					      WAITFORBIN
					          (CQ FILE)
					          (FASTCALL IFSET)
					          (HRRZ 1 , FILEN (FX))
					          (HRRM 1 , AC4)
					          (CV WAITFORK)
					          (MOVEI 2 , ACS)
					      STARTIT
					          (JS SFACS)
					          (MOVEI 2 , 4)
					          (JS SFORK)
					          (MOVEI 1 , 100Q)
					          (JS RFMOD)
					          (PUSHN 2)
					          (TRO 2 , 10000Q)
					          (JS SFMOD)
					          (JS BIN)
					          (NREF (EXCH 2 , 0))
					          (JS SFMOD)
					          (POPN 2)
					          (JUMPE 2 , OUT)
					          (JS BKJFN)
					          (JFCL)
					          (JRST OUT)
					      ACS (JUMP 0)
					          (JUMP 1)
					      AC2 (JUMP 2)
					      AC3 (-1)
					      AC4 (MOVEI 1 , 0)
					      AC5 (JS BIN)
					      AC6 (MOVE 3 , 2)
					      AC7 (JS BKJFN)
					          (JFCL)
					          (MOVEI 1 , 100Q)
					          (MOVEI 2 , 0)
					          (JS STI)
					          (JS HALTF)
					          (JS HALTF)
					      OUT (MOVEI 1 , ASZ (2))))))))))

(REUSEFORK

  (LAMBDA (FORK)
    (COND
      ((AND (FIXP FORK)
	    (GETHASH FORK USERFORKS)
	    (ASSEMBLE NIL
		      (CQ FORK)
		      (MOVE 1 , 0 (1))
		      (CAIL 1 , 400000Q)
		      (CAIL 1 , 400035Q)
		      (JRST LOSE)       (* check if in valid range for 

					fork handle)

		      (JS RFSTS)
		      (JUMP 16Q , LOSE)
                                        (* concession to TOPS-20)

		      (HLRE 1 , 1)      (* LH 1 contains status)

		      (CAIE 1 , 2)      (* must be halted)

		  LOSE(SKIPA 1 , ' NIL)
                                        (* otherwise, not ok)

		      (MOVE 1 , ' T)))
	FORK)
      (T (CFORK)))))
)

(RPAQ WAITFORK
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS WAITFORK USERFORKS)
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (774Q 10240Q (WAITFORINPUT 1010Q . 6761Q) (REUSEFORK 6765Q . 10235Q)))))
STOP