Trailing-Edge
-
PDP-10 Archives
-
BB-5372D-BM
-
traffic/demonstration/rcvseq.cbl
There is 1 other file named rcvseq.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. RCVSEQ.
*
* THIS PROGRAM EXPECTS TO RECEIVE A CONTINUOUS STREAM OF SEQUENTIALLY
* NUMBERED IPCF MESSAGES.
* WHEN A MESSAGE IS RECEIVED THERE ARE THREE POSSIBILITIES:
* 1. THE MESSAGE IS IN SEQUENCE. APPROXIMATELY EVERY 5 MESSAGES, A
* REPLY IS SENT TO THE SENDER OF THE MESSAGES INDICATING THAT FACT
* AND THE HIGHEST MESSAGE NUMBER RECEIVED.
* 2. THE MESSAGE IS OUT OF SEQUENCE. A REPLY IS SENT TO THE SENDER
* INDICATING THAT FACT AND THE LAST GOOD MESSAGE NUMBER RECEIVED.
* 3. THE MESSAGE IS IN SEQUENCE AND THE HIGHEST MESSAGE NUMBER IS
* REACHED. A REPLY IS SENT TO THE SENDER INDICATING THAT THIS
* PROGRAM IS TERMINATING EXECUTION.
*
* THIS PROGRAM MAY REDEFINE ITS IDENTIFICATION AT ANY TIME. IF THE
* REDEFINITION OCCURS WHILE A SEQUENCE IS BEING RECEIVED, A TERMI-
* NATION MESSAGE IS SENT TO THE SENDER.
*
* THE FORMAT OF THE REPLY MESSAGE IS:
* FIELD 1 - 3 ALPHABETIC CHARACTERS
* FIELD 2 - 5 NUMERIC CHARACTERS
* THE FIELDS OF THE THREE POSSIBLE REPLY MESSAGES ARE:
* 1. MESSAGE RECEIVED IN SEQUENCE (POSITIVE ACKNOWLEDGEMENT):
* FIELD 1 - ACK
* FIELD 2 - HIGHEST MESSAGE NUMBER RECEIVED OK
* 2. MESSAGE RECEIVED OUT OF SEQUENCE (NEGATIVE ACKNOWLEDGEMENT):
* FIELD 1 - NAK
* FIELD 2 - HIGHEST MESSAGE NUMBER RECEIVED OK
* 3. THIS PROGRAM HAS COMPLETED (TERMINATION NOTICE):
* FIELD 1 - XIT
* FIELD 2 - HIGHEST MESSAGE NUMBER RECEIVED OK
*
DATA DIVISION.
WORKING-STORAGE SECTION.
77 ERROR-CODE PIC S9(10) COMP.
77 FUNCTION-CODE PIC S9(10) COMP.
77 MY-ID PIC X(29) DISPLAY-7 VALUE SPACES.
77 OTHER-INDEX PIC S9(10) COMP.
77 I PIC S9(10) COMP.
77 MSG-OUT-OF-SEQ PIC S9(10) COMP.
77 MSG-RECV-THIS-ID PIC S9(10) COMP.
77 POS-ACK-SENT PIC S9(10) COMP.
77 LAST-SEQ-NUMBER PIC S9(5).
77 LAST-SEQ-TMP PIC S9(5).
77 ONLY-RECEIVE-INDEX PIC S9(10) COMP.
77 GOOD-MSG-RECV PIC S9(5) COMP.
77 HIGH-SEQUENCE-NUMBER PIC 9(5) VALUE 100.
77 TTY-MSG PIC X(10) DISPLAY-7.
77 RESUME-FLAG PIC S9(5) COMP.
77 WAIT-TIME PIC S9(5) COMP.
77 STIME PIC S9(10) COMP.
77 WAIT-END-TIME PIC S9(10) COMP.
01 TODAY-FIELDS.
02 FILLER PIC XXXXXX.
02 TODAY-HH PIC 99.
02 TODAY-MM PIC 99.
02 TODAY-SS PIC 99.
01 RECEIVE-DEFS.
02 RECEIVE-INFO PIC 9(5).
02 RECEIVE-INDEX PIC S9(10) COMP.
01 IPCF-ACKNOWLEDGEMENT.
02 ACKNOWLEDGE-TYPE PIC XXX.
02 ACKNOWLEDGE-DATA PIC X(5).
01 DSB-COMPS COMP.
02 DSB-WAIT PIC S9(10).
02 DSB-REASON PIC S9(10).
02 DSB-ERROR PIC S9(10).
PROCEDURE DIVISION.
SETUP.
DISPLAY " ".
DISPLAY " RECEIVE A STREAM OF SEQUENTIALLY NUMBERED IPCF MESSAGES".
DISPLAY " ".
PERFORM DEFINE-NEW-ME.
MAIN-LOOP.
SET FUNCTION-CODE TO 0.
SET RESUME-FLAG TO 3.
PERFORM WAIT-FOR-SOMETHING.
IF FUNCTION-CODE = 1 PERFORM TTY-INPUT THRU TTY-EXIT.
IF FUNCTION-CODE = 2 PERFORM IPCF-INPUT THRU IPCF-EXIT.
GO TO MAIN-LOOP.
*
* ROUTINE TO PROCESS IPCF INPUT
*
IPCF-INPUT.
MOVE 2000 TO DSB-WAIT.
MOVE 0 TO DSB-REASON.
MOVE 0 TO DSB-ERROR.
ENTER MACRO IPWAIT USING DSB-WAIT, DSB-REASON, DSB-ERROR.
MOVE SPACES TO RECEIVE-INFO.
ENTER MACRO IPRECV USING RECEIVE-INFO RECEIVE-INDEX ERROR-CODE.
IF ERROR-CODE > 2
PERFORM DISPLAY-IPCF-ERROR
GO TO IPCF-EXIT.
* ACCEPT INPUT FROM ONE PROGRAM ONLY
IF ONLY-RECEIVE-INDEX < 0
MOVE RECEIVE-INDEX TO ONLY-RECEIVE-INDEX.
IF RECEIVE-INDEX NOT = ONLY-RECEIVE-INDEX
MOVE LAST-SEQ-NUMBER TO LAST-SEQ-TMP
SET LAST-SEQ-NUMBER TO 0
PERFORM IPCF-SEND-XIT
MOVE LAST-SEQ-TMP TO LAST-SEQ-NUMBER
ENTER MACRO IPDLDX USING RECEIVE-INDEX,ERROR-CODE
MOVE ONLY-RECEIVE-INDEX TO RECEIVE-INDEX
IF ERROR-CODE NOT = 0
DISPLAY " ERROR FROM IPDLDX " WITH NO ADVANCING
PERFORM DISPLAY-IPCF-ERROR
GO TO IPCF-EXIT
ELSE
GO TO IPCF-EXIT.
SET MSG-RECV-THIS-ID UP BY 1.
* IF SEQUENCE NUMBER NOT INITIALIZED, ATTEMPT TO INITIALIZE IT
IF LAST-SEQ-NUMBER < 0
IF RECEIVE-INFO IS NUMERIC AND RECEIVE-INFO < HIGH-SEQUENCE-NUMBER
COMPUTE LAST-SEQ-NUMBER = RECEIVE-INFO - 1
SET GOOD-MSG-RECV TO 0
ELSE
SET LAST-SEQ-NUMBER TO 0
PERFORM IPCF-SEND-NAK
SET LAST-SEQ-NUMBER TO -1
GO TO IPCF-EXIT.
* PROCESS RECEIVED DATA AS A SEQUENCE NUMBER
IF RECEIVE-INFO IS NUMERIC AND RECEIVE-INFO = LAST-SEQ-NUMBER + 1
MOVE RECEIVE-INFO TO LAST-SEQ-NUMBER
IF LAST-SEQ-NUMBER < HIGH-SEQUENCE-NUMBER
PERFORM IPCF-SEND-ACK
GO TO IPCF-EXIT
* IF REACHED HIGHEST SEQUENCE NUMBER, DEFINE NEW IDENTIFIER
ELSE
PERFORM CLOSE-OLD-ME
DISPLAY " DO YOU WISH TO CONTINUE ? " WITH NO ADVANCING
ACCEPT TTY-MSG
IF TTY-MSG NOT = 'Y' AND 'YES'
STOP RUN
ELSE
PERFORM DEFINE-NEW-ME
GO TO IPCF-EXIT
* COUNT MESSAGES RECEIVED OUT OF SEQUENCE
ELSE
SET MSG-OUT-OF-SEQ UP BY 1
PERFORM IPCF-SEND-NAK.
IPCF-EXIT.
EXIT.
*
* SEND IPCF MESSAGE RECEIVED OK
*
IPCF-SEND-ACK.
SET GOOD-MSG-RECV UP BY 1.
IF GOOD-MSG-RECV > 0
MOVE 'ACK' TO ACKNOWLEDGE-TYPE
PERFORM IPCF-SEND-ACKNOWLEDGE
IF ERROR-CODE = 0
MOVE LAST-SEQ-NUMBER TO POS-ACK-SENT
SET GOOD-MSG-RECV TO 0.
*
* SEND IPCF MESSAGE RECEIVED OUT OF SEQUENCE
*
IPCF-SEND-NAK.
MOVE 'NAK' TO ACKNOWLEDGE-TYPE.
PERFORM IPCF-SEND-ACKNOWLEDGE-WAIT.
*
* SEND IPCF PROGRAM HAS COMPLETED MESSAGE
*
IPCF-SEND-XIT.
MOVE 'XIT' TO ACKNOWLEDGE-TYPE.
PERFORM IPCF-SEND-ACKNOWLEDGE-WAIT.
*
* ROUTINE TO GET IPCF MESSAGE THRU IF NO FATAL ERRORS
*
IPCF-SEND-ACKNOWLEDGE-WAIT.
PERFORM IPCF-SEND-ACKNOWLEDGE.
IF ERROR-CODE NOT = 0
IF ERROR-CODE < 11 OR > 14
DISPLAY " FAILED TO SEND IPCF MESSAGE"
STOP RUN
ELSE
IF ERROR-CODE = 11
DISPLAY " SENDER PROGRAM TERMINATED ? "
ELSE
SET WAIT-TIME TO 5
PERFORM WAIT-FOR-TIME
GO TO IPCF-SEND-ACKNOWLEDGE-WAIT.
*
* ROUTINE TO SEND THE RECORD "IPCF-ACKNOWLEDGE" AS AN IPCF MESSAGE.
* THE DATA IS THE CONTENTS OF "LAST-SEQ-NUMBER".
*
IPCF-SEND-ACKNOWLEDGE.
MOVE LAST-SEQ-NUMBER TO ACKNOWLEDGE-DATA.
SET ERROR-CODE TO -1.
PERFORM IPCF-SEND-ACKNOWLEDGE-1
VARYING I FROM 1 BY 1
UNTIL I > 5 OR ERROR-CODE = 0.
IPCF-SEND-ACKNOWLEDGE-1.
ENTER MACRO IPSEND USING IPCF-ACKNOWLEDGEMENT,RECEIVE-INDEX,ERROR-CODE.
IF ERROR-CODE NOT = 0 AND NOT = 12 AND NOT = 13 AND NOT = 14
PERFORM DISPLAY-IPCF-ERROR.
*
* ROUTINE TO WAIT FOR A SIGNIFICANT EVENT
*
WAIT-FOR-SOMETHING.
ENTER MACRO IPWAIT USING FUNCTION-CODE,RESUME-FLAG,ERROR-CODE.
IF ERROR-CODE NOT = 0
PERFORM DISPLAY-IPCF-ERROR
GO TO WAIT-FOR-SOMETHING.
*
* ROUTINE TO PROCESS TERMINAL INPUT
*
TTY-INPUT.
ACCEPT TTY-MSG.
IF TTY-MSG = "EXIT"
PERFORM CLOSE-OLD-ME
STOP RUN.
IF TTY-MSG = "S" OR "STATUS"
PERFORM DISPLAY-MY-STATUS
GO TO TTY-EXIT.
IF TTY-MSG = "NEW ME" OR "N M" OR "DEF ME" OR "D M"
PERFORM CLOSE-OLD-ME
PERFORM DEFINE-NEW-ME
GO TO TTY-EXIT.
IF TTY-MSG = 'H' OR 'HELP'
PERFORM HELP-THAT-USER
GO TO TTY-EXIT.
DISPLAY "WHAT ??".
TTY-EXIT.
EXIT.
*
* ROUTINE TO DISPLAY THE IPCF ERROR CODE
*
DISPLAY-IPCF-ERROR.
DISPLAY " IPCF ERROR CODE IS " ERROR-CODE.
DISPLAY " ".
*
* ROUTINE TO DEFINE OUR CURRENT PROGRAM IDENTIFIER
*
DEFINE-NEW-ME.
DISPLAY " ".
SET LAST-SEQ-NUMBER TO -1.
SET MSG-OUT-OF-SEQ TO 0.
SET MSG-RECV-THIS-ID TO 0.
SET POS-ACK-SENT TO -1.
SET ONLY-RECEIVE-INDEX TO -1.
SET ERROR-CODE TO -1.
PERFORM DEFINE-NEW-ME-1
VARYING I FROM 1 BY 1
UNTIL I > 5 OR ERROR-CODE = 0.
IF ERROR-CODE NOT = 0
DISPLAY " FAILED TO CREATE NEW IDENTIFICATION"
STOP RUN
ELSE
DISPLAY " NEW IDENTIFICATION CREATED"
DISPLAY " ".
DEFINE-NEW-ME-1.
DISPLAY " CREATE MY IDENTIFICATION " WITH NO ADVANCING.
ACCEPT MY-ID.
ENTER MACRO IPCRID USING MY-ID, ERROR-CODE.
IF ERROR-CODE NOT = 0
PERFORM DISPLAY-IPCF-ERROR.
*
* ROUTINE TO COMPLETE PROCESSING AS ONE PROGRAM IDENTIFIER
*
CLOSE-OLD-ME.
DISPLAY " ".
IF MSG-RECV-THIS-ID > 0
PERFORM IPCF-SEND-XIT.
IF LAST-SEQ-NUMBER > 0
DISPLAY " HIGHEST SEQUENCE RECEIVED " LAST-SEQ-NUMBER.
IF MSG-OUT-OF-SEQ > 0
DISPLAY " RECEIVED " MSG-OUT-OF-SEQ
" MESSAGES OUT OF SEQUENCE".
ENTER MACRO IPDLID USING MY-ID, ERROR-CODE
IF ERROR-CODE NOT = 0
DISPLAY " FAILED TO DELETE MY ID " MY-ID
PERFORM DISPLAY-IPCF-ERROR
STOP RUN.
DISPLAY " ".
DISPLAY " COMPLETED PROCESSING OF " MY-ID.
DISPLAY " ".
*
* ROUTINE TO WAIT FOR SOME TIME PERIOD
* WAIT-TIME CONTAINS THE AMOUNT OF TIME TO WAIT IN SECONDS
* THE MAXIMUM WAIT TIME IS 65 SECONDS
* DURING THE TIME PERIOD:
* TERMINAL INPUT IS PROCESSED
* IPCF INPUT IS IGNORED
*
WAIT-FOR-TIME.
IF WAIT-TIME > 65
SET WAIT-TIME TO 65.
PERFORM GET-STIME.
COMPUTE WAIT-END-TIME = STIME + WAIT-TIME
IF WAIT-TIME = 0
PERFORM WAIT-FOR-TIME-1
ELSE
PERFORM WAIT-FOR-TIME-1 UNTIL STIME NOT < WAIT-END-TIME.
WAIT-FOR-TIME-1.
COMPUTE FUNCTION-CODE = WAIT-TIME * 1000.
SET RESUME-FLAG TO 1.
PERFORM WAIT-FOR-SOMETHING.
IF FUNCTION-CODE = 1
PERFORM TTY-INPUT THRU TTY-EXIT.
PERFORM GET-STIME.
COMPUTE WAIT-TIME = WAIT-END-TIME - STIME.
*
* ROUTINE TO COMPUTE THE CURRENT TIME OF DAY IN SECONDS.
*
GET-STIME.
MOVE TODAY TO TODAY-FIELDS.
COMPUTE STIME = ((TODAY-HH * 60) + TODAY-MM) * 60 + TODAY-SS.
*
* ROUTINE TO DISPLAY CURRENT PROGRAM STATUS
*
DISPLAY-MY-STATUS.
DISPLAY " ".
DISPLAY " MY IDENTIFICATION IS " MY-ID.
DISPLAY " TOTAL MESSAGES RECEIVED " MSG-RECV-THIS-ID.
DISPLAY " HIGHEST SEQUENCE RECEIVED " LAST-SEQ-NUMBER.
DISPLAY " HIGHEST SEQ ACKNOWLEDGED " POS-ACK-SENT.
DISPLAY " OUT OF SEQUENCE MESSAGES " MSG-OUT-OF-SEQ.
DISPLAY " ".
*
* ROUTINE TO PRINT HELP MESSAGE ON THE TERMINAL
*
HELP-THAT-USER.
DISPLAY " ".
DISPLAY " THE VALID COMMANDS ARE:".
DISPLAY " DEF ME OR".
DISPLAY " D M TO DEFINE NEW PROGRAM IDENTIFIER".
DISPLAY " EXIT TO TERMINATE THE PROGRAM".
DISPLAY " HELP OR"
DISPLAY " H TO DISPLAY THIS MESSAGE".
DISPLAY " NEW ME OR".
DISPLAY " N M TO DEFINE A NEW PROGRAM IDENTIFIER".
DISPLAY " STATUS OR".
DISPLAY " S TO DISPLAY CURRENT PROGRAM STATUS".
DISPLAY " ".