Trailing-Edge
-
PDP-10 Archives
-
BB-5372D-BM
-
traffic/demonstration/trupts.cbl
There is 1 other file named trupts.cbl in the archive. Click here to see a list.
00100 IDENTIFICATION DIVISION.
00200 PROGRAM-ID. TRUPTS.
00300 *
00400 * THIS PROGRAM IS THE SENDER HALF OF THE TWO PROGRAMS WHICH MEASURE THE
00500 * THROUGH-PUT OF THE COBOL INTERPROGRAM COMMUNICATION ROUTINES. IT SENDS
00600 * A CONTINUOUS STREAM OF FULL LENGTH SIXBIT MESSAGES TO THE RECEIVER PROGRAM.
00700 *
00800 DATA DIVISION.
00900 WORKING-STORAGE SECTION.
01000 77 ERROR-CODE PIC S9(10) COMP.
01100 77 MY-ID PIC X(29) DISPLAY-7 VALUE "THRUPUT-SENDER".
01200 77 OTHER-ID PIC X(29) DISPLAY-7 VALUE "THRUPUT-RECEIVER".
01300 77 OTHER-INDEX PIC 9(10) COMP.
01400 77 IPCF-MESSAGE PIC X(3060).
01500 PROCEDURE DIVISION.
01600 START.
01700 ENTER MACRO IPCRID USING MY-ID, ERROR-CODE.
01800 IF ERROR-CODE NOT = 0
01900 PERFORM DISPLAY-IPCF-ERROR
02000 STOP RUN.
02100 DISPLAY " I AM DEFINED AS " MY-ID.
02200 DISPLAY " ".
02300 ENTER MACRO IPCRDX USING OTHER-ID, OTHER-INDEX, ERROR-CODE.
02400 IF ERROR-CODE NOT = 0
02500 IF ERROR-CODE = 17
02600 DISPLAY " NOT RUNNING " OTHER-ID
02700 STOP RUN
02800 ELSE
02900 PERFORM DISPLAY-IPCF-ERROR
03000 STOP RUN.
03100 DISPLAY " SENDING LIKE CRAZY !!!!".
03200 MAIN-LOOP.
03300 ENTER MACRO IPSEND USING IPCF-MESSAGE, OTHER-INDEX, ERROR-CODE.
03400 IF ERROR-CODE NOT = 0 AND NOT = 12 AND NOT = 13 AND NOT = 14
03500 PERFORM DISPLAY-IPCF-ERROR
03600 STOP RUN.
03700 GO TO MAIN-LOOP.
03800 DISPLAY-IPCF-ERROR.
03900 DISPLAY " ERROR CODE IS " ERROR-CODE.
04000 DISPLAY " ".