Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,inputwait);
INTEGER PROCEDURE inputwait(filearray,maxtime);
REF(Infile)ARRAY filearray;
REAL maxtime;
COMMENT The array filearray must be one-dimensional. Elements==NONE are ignored.
INPUTWAIT checks each file of the array for pending input. If there is none,
although open files do exist, INPUTWAIT goes to sleep until awakened.
A wake-up signal is triggered by input or when maxtime has elapsed.
On awakening, all files are checked again.
The index of the first file with a line of input ready is returned.
Open disk files are always considered to be ready, except on end-of-file.
If no input can be expected, or an error occurs, INPUTWAIT returns a value
= lower bound(filearrays) - 1.
[267]
A PTY file which has no input (output from subjob) is nevertheless
considered ready if it can accept output (subjob input).
In that case, INPUTWAIT returns array index + 2^18.
If return is because of elapsed maxtime, lower bound - 2 is returned.
;

!*;! MACRO-10 code !*;!

	TITLE	inputwait
	ENTRY	inputwait
	SUBTTL	SIMULA utility, Lars Enderin Dec 1975

;! Copyright 1975 by the Swedish Defence Research Institute.
;! Copying is allowed.

	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	OPDEF	IONDX.	[CALLI	127]
	DEFINE	ierr(con,t)<
	EXEC	.ierr
	NOP	con,[ASCIZ"t"]
	>
	xp==	XWAC6
	xp1==	XWAC5
	xfil==	XWAC1
	xa==	XIAC
	maxtime==XWAC2
	endtime==XWAC4	;! Sleep at most until then
	lb==OFFSET(ZARLOW)+2
	ub==OFFSET(ZARUPP)+2
	GL.LIN==1B11	;! Line of input ready (GETLCH)

inputwait:
	PROC
	EXCH	XWAC1,(XTAC)
	EXCH	XWAC2,1(XTAC)
	EXCH	XWAC3,2(XTAC)
	STACK	XWAC4
	STACK	XWAC5
	STACK	XWAC6
	STACK	XTAC
	LI	xa,(XWAC1)	;! Array address
	LF	,ZARSUB(xa)
	CAIE	1
	 ierr	,<More than 1 subscript>
	SETO
	WAKE	;! Clear any old wake bits
	 NOP	;! Ignore error return
		;! Next HIBER will wake up immediately
		;! Wake up conditions may have to be modified???
	MSTIME	endtime,	;! Read clock
	LF	xp1,ZARBAD(xa)
	L	lb(xa)
	ADDM	xp1
	SUBI	1
	SUB	ub(xa)
	JUMPG	notfound
	HRLM	xp1	;! AOBJN word
	QWAKEUP==(HB.RTL+HB.RPT) ;! Wake up on line of input or PTY activity
	MOVSI	X1,QWAKEUP	;! First HIBER will return directly due to WAKE
	HIBER	X1,
	 ierr	QDSCON,First HIBER failed
	EXEC	checkinput	;! Returns only if no input waiting
	JUMPGE	xa,notfound	;! No file was open

	;! ** Set up for waiting ** ;!
	IF	;! maxtime > 0
		JUMPLE	maxtime,FALSE
	THEN	;! Compute wake up time, ms wait time
		IF	;! Too long time to use in HIBER UUO
			CAMG	maxtime,[6.7E1]
			GOTO	FALSE
		THEN	;! Use DAEMON CLOCK function
			FIXR	X1,maxtime	;! Full seconds only
			LI	X0,2		;! CLOCK function
			LI	X2,X0
			DAEMON	X2,
			 RFAIL	DAEMON failure
			FLTR	maxtime,X1	;! Round off secs
			IMULI	X1,^D1000	;! msecs
			ADD	endtime,X1
			SETZ	X1,		;! DAEMON will wake job up
		ELSE	;! Just compute msecs for HIBER
			L	X1,maxtime
			FMPRI	X1,(1.0E3)
			FIXR	X1,X1
			SKIPN	X1
			LI	X1,1		;! Make it at least one msec
			ADD	endtime,X1
		FI
	ELSE	;! Indefinite sleep
		SETZ	X1,
		HRLOI	endtime,377777	;! Infinite endtime!!
	FI

	LOOP	;! While there is still hope for some input
		HRLI	X1,QWAKEUP
		HIBER	X1,
		 ierr	QDSCON,HIBER failure
		MSTIME	X2,	;! Read clock again
		EXEC	checkinput
		L	endtime	;! Time to go
		SUB	X2
		IF	;! Time is up
			JUMPG	FALSE
		THEN	;! Return lower bound - 2
			L	xp,lb(xa)
			SUBI	xp,2
			BRANCH	out
		FI
	AS
		JUMPLE	maxtime,TRUE	;! (indefinite sleep)
		TRNN	X1,-1
		GOTO	TRUE		;! If DAEMON will wake us
		HRRM	X1		;! New interval for HIBER
		GOTO	TRUE
	SA
notfound:	;! Return lower bound - 1
	L	xp,lb(xa)
	SOJA	xp,out

found:	LI	xp,(xp)
foundpty:
	edit(267)	;! [267]
	UNSTK	(XPDP)	;! Reset stack pointer
	SUB	xp,OFFSET(ZARBAD)(xa)

out:	L	XWAC1,xp
	UNSTK	XTAC
	UNSTK	XWAC6
	UNSTK	XWAC5
	UNSTK	XWAC4
	EXCH	XWAC3,2(XTAC)
	EXCH	XWAC2,1(XTAC)
	EXCH	XWAC1,(XTAC)
	RETURN
	EPROC

checkinput:
	PROC	;! Check the array for input ready to read

	L	xp,xp1
	LOOP
		L	xfil,(xp)
		IF	;! xfil =/= NONE AND xfil is open
			CAIE	xfil,NONE
			SKIPE	OFFSET(ZIFEND)(xfil)
			GOTO	FALSE
		THEN	;! See if it has anything to offer
			HRROS	xa	;! Flag possible input coming
			LF	,ZFIKAR(xfil)
			edit(267)	;! [267]
			IF	;! TTY
				IFOFFA	ZFITTY
				GOTO	FALSE
			THEN
				IF	;! Controlling TTY
					IFOFFA	ZFITA
					GOTO	FALSE
				THEN	;! Simple check
					IF	;! A line is ready
						SKPINL
						GOTO	FALSE
					THEN
						GOTO	found
					FI
				ELSE	;! Must find universal io index etc
					LF	,ZFIDVN(xfil)
					IONDX.
					SETZ	;! Error
					IF	;! UDX found ok
						JUMPE	FALSE
					THEN
						GETLCH
						TLNE	(GL.LIN)
						GOTO	found
				FI	FI
			ELSE	;! Could be PTY?
				LF	,ZFICHN(xfil)
				DEVTYP
				 GOTO	L9
				TLNN	(TY.AVL)
				 GOTO	L9	;! Does not belong to me!
				ANDI	TY.DEV
				CAIN	.TYDSK
				 GOTO	found	;! DSK
				CAIE	.TYPTY
				 GOTO	L9	;! Not a PTY
				LF	,zfichn(xfil)
				JOBSTS
				 GOTO	L9	;! Error
				TLNE	(JB.UOA)
				 GOTO	found	;! Subjob has output for us
				TLNN	(JB.UDI)
				 GOTO	L9	;! Nothing there
				HRLI	xp,1	;! Signal ready for PTY output
				GOTO	foundpty
		FI	FI
	AS
L9():!		INCR	xp,TRUE
	SA
	RETURN
	EPROC

.ierr:	PROC
	OUTSTR	[ASCIZ"
%ZYLINW Error in INPUTWAIT procedure: "]
	L	X1,@(XPDP)
	OUTSTR	(X1)
	OUTSTR	[ASCIZ/
/]
	IF	;! Continuing
		TLNN	X1,(Z 17,)
		GOTO	FALSE
	THEN
		RTSERR	QDSCON,214
	ELSE
		RTSERR	214
	FI
	BRANCH	notfound
	EPROC

	LIT
	END;