Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(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