Trailing-Edge
-
PDP-10 Archives
-
BB-5372D-BM
-
traffic/demonstration/truptr.cbl
There is 1 other file named truptr.cbl in the archive. Click here to see a list.
00100 IDENTIFICATION DIVISION.
00200 PROGRAM-ID. TRUPTR.
00300 *
00400 * THIS PROGRAM IS THE RECEIVER HALF OF THE TWO PROGRAMS WHICH MEASURE THE
00500 * THROUGH-PUT OF THE COBOL INTERPROGRAM COMMUNICATION ROUTINES. IT RECEIVES
00600 * A CONTINUOUS STREAM OF FULL LENGTH SIXBIT MESSAGES FROM THE SENDER PROGRAM.
00700 * IT STOPS RECEIVING WHEN TERMINAL INPUT IS DETECTED AND COMPUTES THE
00800 * APPROXIMATE THROUGH-PUT VALUE IN MESSAGES PER SECOND.
00900 *
01000 DATA DIVISION.
01100 WORKING-STORAGE SECTION.
01200 77 ERROR-CODE PIC S9(10) COMP.
01300 77 FUNCTION-CODE PIC S9(10) COMP.
01400 77 RESUME-CONDITIONS PIC S9(10) COMP VALUE 3.
01500 77 MY-ID PIC X(29) DISPLAY-7 VALUE "THRUPUT-RECEIVER".
01600 77 TTY-MSG PIC X(10) DISPLAY-7.
01700 77 START-TIME PIC 9(10) COMP.
01800 77 TIME-INTERVAL PIC 9(5) COMP.
01900 77 THRU-PUT PIC 999V99.
02000 77 MSG-COUNT PIC 9(9) COMP VALUE 0.
02100 77 STIME PIC 9(10) COMP.
02200 01 TODAY-FIELDS.
02300 02 FILLER PIC XXXXXX.
02400 02 TODAY-HH PIC 99.
02500 02 TODAY-MM PIC 99.
02600 02 TODAY-SS PIC 99.
02700 01 RECEIVE-DEFS.
02800 02 RECEIVE-INFO PIC X(3060).
02900 02 RECEIVE-INDEX PIC 9(10) COMP.
03000 PROCEDURE DIVISION.
03100 SETUP.
03200 DISPLAY " ".
03300 DISPLAY " MEASURE COBOL IPCF THROUGH-PUT ".
03400 DISPLAY " ".
03500 PERFORM DEFINE-ME.
03600 DISPLAY " TYPE EXIT TO EXIT OR".
03700 DISPLAY " TYPE A BREAK CHARACTER WHEN READY TO BEGIN.".
03800 DISPLAY " TYPE ANOTHER BREAK CHARACTER WHEN READY TO STOP.".
03900 SETUP-REPEAT.
04000 SET MSG-COUNT TO ZERO.
04100 DISPLAY " ".
04200 DISPLAY " ".
04300 DISPLAY " WAITING " WITH NO ADVANCING.
04400 ACCEPT TTY-MSG.
04500 IF TTY-MSG = "EXIT" STOP RUN.
04600 PERFORM GET-STIME.
04700 MOVE STIME TO START-TIME.
04800 MAIN-LOOP.
04900 SET FUNCTION-CODE TO 0.
05000 ENTER MACRO IPWAIT USING FUNCTION-CODE,RESUME-CONDITIONS, ERROR-CODE.
05100 IF FUNCTION-CODE NOT = 2 GO TO LOOP-1.
05200 ENTER MACRO IPRECV USING RECEIVE-INFO, RECEIVE-INDEX, ERROR-CODE.
05300 IF ERROR-CODE = 0
05400 SET MSG-COUNT UP BY 1
05500 GO TO MAIN-LOOP.
05600 PERFORM DISPLAY-IPCF-ERROR.
05700 STOP RUN.
05800 LOOP-1.
05900 IF FUNCTION-CODE NOT = 1 GO TO MAIN-LOOP.
06000 PERFORM GET-STIME.
06100 COMPUTE TIME-INTERVAL = STIME - START-TIME.
06200 COMPUTE THRU-PUT = MSG-COUNT / TIME-INTERVAL.
06300 DISPLAY " ".
06400 DISPLAY " RECEIVED " MSG-COUNT " MESSAGES IN " TIME-INTERVAL
06500 " SECONDS.".
06600 DISPLAY " ".
06700 DISPLAY " THEREFORE, THROUGH-PUT IS " THRU-PUT " MESSAGES/SECOND.".
06800 ACCEPT TTY-MSG.
06900 GO TO SETUP-REPEAT.
07000 *
07100 * ROUTINE TO COMPUTE THE CURRENT TIME OF DAY IN SECONDS.
07200 *
07300 GET-STIME.
07400 MOVE TODAY TO TODAY-FIELDS.
07500 COMPUTE STIME = ((TODAY-HH * 60) + TODAY-MM) * 60 + TODAY-SS.
07600 *
07700 * ROUTINE TO DISPLAY THE IPCF ERROR CODE
07800 *
07900 DISPLAY-IPCF-ERROR.
08000 DISPLAY " IPCF ERROR CODE IS " ERROR-CODE.
08100 DISPLAY " ".
08200 *
08300 * ROUTINE TO DEFINE OUR CURRENT PROGRAM IDENTIFIER
08400 *
08500 DEFINE-ME.
08600 ENTER MACRO IPCRID USING MY-ID, ERROR-CODE.
08700 IF ERROR-CODE NOT = 0
08800 PERFORM DISPLAY-IPCF-ERROR
08900 STOP RUN.
09000 DISPLAY " I AM DEFINED AS " MY-ID.
09100 DISPLAY " ".