Google
 

Trailing-Edge - PDP-10 Archives - bb-d857a-sm_dx_tops20_v1_src - dx/sources/rcvmsg.for
There is 1 other file named rcvmsg.for in the archive. Click here to see a list.
C	       PACKAGE	       :       DX/TOPS20
C	       VERSION         :       V1.0
C	       OP. SYSTEM      :       TOPS20 V3.0
C
C              PROGRAM         :       WPIP
C	       MODULE          :       RCVMSG.FOR
C	       MODULE #        :       4 OF 13
C	       EDIT            :       019
C	       EDIT DATE       :       23-AUG-78
C
C
C
C**********************************************************************
C
C	       C O P Y R I G H T
C
C
C	COPYRIGHT (C) 1978
C       DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS
C
C
C       THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY  ON  A
C       SINGLE  COMPUTER  SYSTEM  AND  MAY  BE  COPIED  ONLY  WITH THE
C       INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE,  OR
C       ANY  OTHER  COPIES  THEREOF,  MAY NOT BE PROVIDED OR OTHERWISE
C       MADE AVAILABLE TO ANY OTHER PERSON  EXCEPT  FOR  USE  ON  SUCH
C       SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE TERMS.  TITLE TO
C       AND OWNERSHIP OF THE SOFTWARE SHALL AT  ALL  TIMES  REMAIN  IN
C       DIGITAL.
C  
C       THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT
C       NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
C       EQUIPMENT CORPORATION.
C  
C       DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE  OR  RELIABILITY
C       OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
C  
C**********************************************************************
C
C
C  RCVMSG -- THE ONLY SUBROUTINE WHICH RECEIVES MESSAGES
C            DIRECTLY FROM THE WPS LINE.
C
C
C	E D I T  H I S T O R Y
C
C
C	EDIT   DATE	BY		DESCRIPTION
C	000    1/11/78	R.K. BLACKETT	INITIAL IMPLEMENTATION.
C	001    2/2/78	G.A. REID	ADD TESTING OF RETURNED
C					I/O STATUS.
C	002    2/22/78  R.K. BLACKETT	IMPLEMENT OVERLAPPED INPUT.
C	003    2/23/78  R.K. BLACKETT	IMPLEMENT TIME-OUT CHECKING.
C	004    2/24/78	G.A. REID	MAKE PRINTING OF MESSAGES SENT
C					A 'DEBUG' TIME ONLY OCCURANCE.
C	005    2/24/78  R.K. BLACKETT	CHECK FOR PREVIOUS MESSAGE
C					BEING A "PROMPT" BEFORE
C					TIMING OUT.
C	006    2/24/78  R.K. BLACKETT	ALSO DON'T TIMEOUT IF PREVIOUS
C					MESSAGE IS "MESSAGE" OR IF TRYING
C					TO ESTABLISH LOW-LEVEL CONNECT.
C	007    2/27/78  G.A. REID	REMOVE CODE NO LONGER NEEDED AND
C					CHANGE TO QIO FUNCTION CODE "1000.
C	008    2/27/78  G.A. REID	ADD DETECTION OF CTRL-Z (EOF).  IF
C					^Z IS TYPED, CALL STOPIT TO STOP
C					PROCESSING.
C	009    3/3/78	G.A. REID	PUT IN COPYRIGHT STATEMENT.
C
C	010    3/6/78	J. COHEN	SEND ERROR MESSAGE IF HARDWARE
C					ERROR ENCOUNTERED AND RETRY
C					ATTEMPTS > 10, THEN STOP.
C					ALSO SEND MESSAGE AND STOP IF
C					A TIME-OUT OCCURS.
C
C	011	3/7/78	J. COHEN	ON ERRORS MENTIONED IN EDIT
C					#010, ALTER CODE TO SIMPLY
C					CLOSE FILES AND THEN REIN-
C					ITIALIZE. ALSO ALLOW FOR THE
C					CORRECT NUMBER OF 'NAK'S TO BE
C					SENT.
C
C	012	3/8/78	J. COHEN	ALLOW A 1 MINUTE TIMEOUT ONLY
C					IF A POSSIBLE STALEMATE MIGHT
C					OCCUR. THIS SITUATION COULD
C					ARISE IF THE WPS USER HAD
C					ORIGINALLY TYPED 'S' FILE
C					BUT THEN TYPED 'R' DOCUMENT.
C
C	013	3/9/78	J. COHEN	AT INITIALIZATION TIME CLEAR
C					THE READ EVENT FLAG AND ELIMI-
C					NATE THE POSSIBILITY OF AN
C					OUTSTANDING READ.
C					IF SITUATION DESCRIBED IN EDIT
C					#012 OCCURS ALSO CLEAR THIS
C					EVENT FLAG.
C
C	014	3/9/78	J. COHEN	ISSUE A CALL TO CLEAR THE MARK
C					TIME EVENT FLAG IF AT ANY TIME
C					IT WAS SET.
C
C**********************************************************************
C**********************************************************************
C	015	3/17/78	J. COHEN	CHANGES TO 'WP8PIP' FROM THIS
C					POINT ON REFLECT CHANGES FOR
C					TOPS20.
C
C	016	7/27/78	J. COHEN	MAKE THE NECESSARY CHANGES TO
C					ALLOW FOR THE NEW ROUTINES
C					WHICH WILL PERFORM I/O AND
C					MARK TIME.
C
C	017	3/28/78	J. COHEN	CHANGE CODE WHICH DETERMINES
C					WHETHER OR NOT A TIME OUT OR
C					AN INPUT REQUEST IS COMPLETE
C
C	018	8/9/78	J. COHEN	ADD A NEW ENTRY POINT--RCVSTA
C					WHICH ALLOWS THE INTERROGATION
C					OF THE READ EVENT FLAG.
C
C	019	8/23/78	J. COHEN	ALLOW FOR RESENDING OF PACKETS
C					IF NO RESPONSE IS RECEIVED WITHIN
C					5 SECONDS, DO THIS 5 TIMES AND THEN
C					ASSUME A TIME OUT.
C
C**********************************************************************
C
C
	SUBROUTINE RCVMSG(LEN)
	IMPLICIT INTEGER (A-Z)
	DIMENSION RBUF(80),BACKUP(80),SBUF(80)
	INTEGER ISTAT(2),RCV(6),SND(6)
	COMMON /RCOM/ BACKUP,RLEN,IEF,RERR
	COMMON /SCOM/ SBUF,SLEN,IEFS,SERR
	COMMON /BCOM/ RBUF
	COMMON /WCOM/ MEF,ITIME,IDU
	COMMON MESIN,MESOUT,LSTMSG,LGOOD,LEVEL,MSGWTG
	1 ,IERRC,IERRCT,MSGFLG,IBYE,IFLAG
	DATA IOUNDR/1/
	ICNT = 0
	ITMO = 0
	ITIME = 0
C 
C  SET A MARK TIME FOR 5 SECONDS IF THE
C  PREVIOUS MESSAGE WASN'T A "PROMPT" OR A "MESSAGE"
C  OR AN "OPTIONS" OR A LOW LEVEL PACKET.
C
40	IF(SBUF(2) .EQ. "142
	1 .OR. BACKUP(2) .EQ. "146 .OR. SBUF(2) .EQ. "146
	2 .OR. SBUF(2) .EQ. "153 .OR. LEVEL .NE. 2) GO TO 41
C
C  A MARK TIME HAS BEEN STARTED WITH THE SETTING OF 'ITIME'.
C  SINCE A REQUEST FOR INPUT HAS ALSO BEEN MADE WE SHOULD
C  CONTINUE LOOPING AT THIS POINT IF 'ITIME' NOT = 0 AND
C  THE READ REQUEST HAS NOT YET COMPLETED.
C
C
	ITIME = 5000
C
C NOW WAIT FOR EITHER READ OR DELAY TO COMPLETE
C
C  AT THIS POINT WILL BE CHECKING THE STATUS OF A
C  FLAG WHICH WAS SET IN ONE OF SEVERAL PARALLEL ROUTINES
C  IN ORDER TO DETERMINE IF I/O OR TIME LIMIT IS COMPLETE.
C  IF 'ITIME' = 0 THEN TIME OUT OCCURRED, BUT IF 'IEF' <= 1 THEN
C  I/O OPERATION IS NOT YET COMPLETE -- CONTINUE CHECKING.
C  NOW GO TO 200 IF IT IS THE TIME OUT, AND NOT THE READ
C  WHICH HAS COMPLETED.
C
41	IF(IEF .GE. 2 .OR. MEF .EQ. 1)GO TO 42
	CALL SPEC
	GO TO 41
42	IF(IEF .NE. 2 .AND. IEF .NE. 3) GO TO 200
C
C  IF INPUT IS COMPLETE, RESET 'ITIME' TO 0 AND CONTINUE.
C
	ITIME = 0
	MEF = 0
C
C  SEE IF CTRL-Z HAS BEEN TYPED.
C
	IF (IEF .EQ. 3) CALL STOPIT
	LEN = RLEN
D	WRITE(23,900)
D900	FORMAT(' RECEIVED:')
D	CALL PRINT(BACKUP,LEN)
C
C  IF HARDWARE ERROR OCCURRED, THEN GO TO 50 TO PROCESS IT,
C  OTHERWISE, PROCESS INPUT BUFFER.
C
	IF(RERR .EQ. 1) GO TO 50
	IEF = 0
	DO 23 I=1,LEN
	RBUF(I) = BACKUP(I)
23	CONTINUE
C
C  RESET INPUT INDICATOR TO READ THE BUFFER AND THEN RETURN
C
	CALL REA