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