Trailing-Edge
-
PDP-10 Archives
-
decuslib20-06
-
decus/20-153/rpghhh.cbl
There is 1 other file named rpghhh.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. RPGHHH.
DATE-WRITTEN. APRIL 13, 1976.
AUTHOR. HAL ROACH.
INSTALLATION. CERRITOS COLLEGE.
REMARKS. PROGRAM TO UPDATE H CARD.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. DECSYSTEM-10.
OBJECT-COMPUTER. DECSYSTEM-10.
SPECIAL-NAMES.
CONSOLE IS TTY.
CHANNEL (1) IS HOF.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PROGRAM-FILE ASSIGN TO DSK
ACCESS MODE IS RANDOM
ACTUAL KEY IS PROGRAM-KEY
FILE LIMIT IS 99999.
DATA DIVISION.
FILE SECTION.
FD PROGRAM-FILE
BLOCK CONTAINS 8 RECORDS
LABEL RECORDS ARE STANDARD
VALUE OF IDENTIFICATION IS PROGRAM-IDENTIFICATION
DATA RECORD IS PROGRAM-RECORD.
01 PROGRAM-RECORD PIC X(90).
WORKING-STORAGE SECTION.
77 NUM-IT-2 PIC 99.
77 ELE-9 PIC 99.
77 CLEAR-IT PIC X(34) VALUE SPACES.
77 CLEAR-3300 PIC X(26) VALUE SPACES.
77 ERROR-CODE PIC X.
77 I PIC S9(5) COMP.
77 J PIC S9(5) COMP.
77 K PIC S9(5) COMP.
77 L PIC 9(5) COMP.
77 PROGRAM-KEY PIC 9(5) COMP.
77 NEXT-PROGRAM PIC X(6).
01 ELEM-NO.
02 ELE-NUM PIC XX.
01 NO-ELEM REDEFINES ELEM-NO.
02 NUM-ELE PIC 99.
01 DATA-STORAGE.
02 DATA-A PIC XXX OCCURS 14 TIMES.
01 THE-DATA.
02 DATA-1 PIC X.
02 DATA-2 PIC XX.
01 PROGRAM-ZERO.
02 FILLER PIC X(80).
02 PROGRAM-REC-NO PIC 9(5).
02 PROGRAM-LAST-REC PIC 9(5).
01 PROGRAM-MAIN.
02 PROGRAM-PAGE PIC 99.
02 PROGRAM-LINE PIC 999.
02 PROGRAM-FORM PIC X.
02 PROGRAM-INFO.
03 FILLER PIC X.
03 STAR-COMMENT PIC X(67).
02 PROGRAM-IDENT PIC X(6).
02 PROGRAM-ACT-REC PIC 9(5).
02 PROGRAM-FILL PIC 9(5).
01 PROG-INFO.
02 FIL-LER.
03 THE-STARE PIC X.
03 FILLER PIC XX.
02 OBJ-OUT PIC X.
02 LIS-OPT PIC X.
02 COR-SIZ PIC XXX.
02 SIZ-COR REDEFINES COR-SIZ PIC ZZ9.
02 DEBUG PIC X.
02 FILLER PIC X(5).
02 INV-PRI PIC X.
02 FILLER PIC X(4).
02 ACT-COL PIC X.
02 FILLER PIC X(10).
02 INQ PIC X.
02 FILLER PIC XXX.
02 1P-FOR PIC X.
02 FILLER PIC X.
02 FIL-TRA PIC X.
02 PUN-MFC PIC X.
02 NON-CHA PIC X.
02 FILLER PIC XX.
02 SHA-I-O PIC X.
02 FILLER PIC X(26).
01 PROG-COMMENT.
02 THE-STAR PIC X VALUE "*".
02 THE-COMMENT PIC X(67).
01 TUBE-TITLE.
02 TUBE-LINE-0.
03 FILLER PIC X(4) VALUE "PAGE".
03 DISPLAY-PAGE PIC ZZZ.
03 FILLER PIC X(5) VALUE " LINE".
03 DISPLAY-LINE PIC Z(4).
03 FILLER PIC X(34) VALUE
" H DATA CARD".
02 TUBE-LINE-1 PIC X(50) VALUE
"ELEMENT ELEMENT ELEMENT".
02 TUBE-LINE-2 PIC X(50) VALUE
"NUMBER DESCRIPTION [ENTRY]".
01 TUBE-DISPLAY.
02 FILLER PIC X(37) VALUE
"OBJECT OUTPUT [ ]".
02 FILLER PIC X(37) VALUE
"LISTING OPTIONS [ ]".
02 FILLER PIC X(37) VALUE
"CORE SIZE TO EXECUTE [ ]".
02 FILLER PIC X(37) VALUE
"DEBUG [ ]".
02 FILLER PIC X(37) VALUE
"INVERTED PRINT [ ]".
02 FILLER PIC X(37) VALUE
"ALTERNATE COLLATING SEQUENCE [ ]".
02 FILLER PIC X(37) VALUE
"INQUIRY [ ]".
02 FILLER PIC X(37) VALUE
"1P FORMS POSTION [ ]".
02 FILLER PIC X(37) VALUE
"FILE TRANSLATION [ ]".
02 FILLER PIC X(37) VALUE
"PUNCH MFCU ZEROS [ ]".
02 FILLER PIC X(37) VALUE
"NONPRINT CHARACTERS [ ]".
02 FILLER PIC X(37) VALUE
"SHARED I/O AREA [ ]".
01 DISPLAY-TUBE REDEFINES TUBE-DISPLAY.
02 FILLER OCCURS 12 TIMES.
03 THE-TUBE PIC X(37).
01 THE-NUMBER.
02 II PIC Z(5).
02 FILLER PIC XXX.
01 PROGRAM-IDENTIFICATION.
02 PROGRAM-NAME PIC X(6).
02 PROGRAM-EXT PIC XXX VALUE "TMP".
01 PASS-IT.
02 THE-FILE PIC X(6).
02 THE-TERM PIC X.
02 THE-ACTION PIC XXX.
02 THE-PAGE PIC 99.
02 THE-LINE PIC 999.
02 THE-FORM PIC X.
02 R-TYPE PIC X.
01 ALL-DATA.
02 ALL-1 PIC X.
02 ALL-23.
03 ALL-2 PIC X.
03 ALL-3 PIC X.
PROCEDURE DIVISION.
START SECTION.
BEGIN.
ENTER MACRO TRAP.
MOVE SPACES TO PASS-IT.
* DISPLAY "PASS-IT = " WITH NO ADVANCING ACCEPT PASS-IT.
ENTER MACRO GTPRMS USING PASS-IT "X".
IF THE-TERM = "A" OR "D" OR "V" OR "3" OR "B"
GO TO CONT-PROG.
DISPLAY "THE DRIVER PROGRAM WAS NOT USED".
STOP RUN.
CONT-PROG.
MOVE THE-FILE TO PROGRAM-NAME.
IF THE-ACTION = "CHG"
PERFORM FIND-REC THRU END-FIND-REC.
PERFORM CLEAR-SCREEN.
ENTER MACRO SETTY USING "NO CRLF".
ENTER MACRO SETTY USING "WIDTH 80".
ENTER MACRO SETTY USING "FORM".
IF THE-STARE = "*"
MOVE 1 TO K
MOVE THE-STARE TO DATA-1
MOVE FIL-LER TO DATA-A (1)
GO TO COMMENT-CHECK.
MOVE THE-PAGE TO DISPLAY-PAGE.
MOVE THE-LINE TO DISPLAY-LINE.
DISPLAY TUBE-LINE-0.
DISPLAY TUBE-LINE-1.
DISPLAY TUBE-LINE-2.
MOVE 3 TO I.
LOOP-DISPLAY.
ADD 1 TO I.
IF I > 15 GO TO END-DISPLAY.
SUBTRACT 3 FROM I GIVING K.
MOVE K TO II.
MOVE 1 TO J.
PERFORM CURSOR.
DISPLAY THE-NUMBER THE-TUBE (K) WITH NO ADVANCING.
MOVE 42 TO J.
PERFORM CURSOR.
DISPLAY DATA-A (K).
GO TO LOOP-DISPLAY.
END-DISPLAY.
IF THE-ACTION = "ADD"
GO TO ADD-IT.
FIND-NUMBER.
MOVE 23 TO I.
MOVE 1 TO J.
PERFORM CURSOR.
DISPLAY "ELEMENT NUMBER = " WITH NO ADVANCING.
MOVE SPACES TO ELE-NUM.
DISPLAY ELE-NUM WITH NO ADVANCING.
MOVE 18 TO J.
PERFORM CURSOR.
ACCEPT ELE-NUM.
IF ELE-NUM = "EN"
PERFORM CHG-REC THRU END-CHG-REC
PERFORM CLEAR-SCREEN
GO TO END-IT.
MOVE NUM-ELE TO ELE-9.
EXAMINE ELE-NUM REPLACING ALL SPACES BY ZERO.
IF ELE-NUM IS NOT NUMERIC
PERFORM BAD-NUMBER
GO TO FIND-NUMBER.
IF ELE-9 < 1 OR ELE-9 > 12
PERFORM BAD-NUMBER
GO TO FIND-NUMBER.
MOVE 23 TO I.
MOVE 20 TO J.
PERFORM CURSOR.
PERFORM CLEAR-LINE.
MOVE ELE-9 TO I.
ADD 3 TO I.
BY-NUM.
MOVE 42 TO J.
PERFORM CURSOR.
SUBTRACT 3 FROM I GIVING K.
MOVE K TO II.
ACCEPT-CHG.
ACCEPT DATA-A (K).
IF THE-ACTION = "ADD"
MOVE DATA-A (K) TO ALL-DATA.
IF ALL-1 = "/"
GO TO CHECK-SLASH.
IF K = 1
GO TO COMMENT-CHECK.
EDIT-IT.
PERFORM THE-EDIT.
IF ERROR-CODE = "X"
MOVE SPACE TO ERROR-CODE
MOVE 42 TO J
PERFORM CURSOR
GO TO ACCEPT-CHG.
PERFORM CLEAN-IT.
MOVE 42 TO J.
PERFORM CURSOR.
DISPLAY DATA-A (K).
IF THE-ACTION = "ADD" GO TO LOOP-VALUE.
GO TO FIND-NUMBER.
CHECK-SLASH.
IF ALL-2 = "E"
GO TO END-VALUE.
MOVE ALL-23 TO NUM-IT-2.
EXAMINE ALL-23 REPLACING ALL SPACES BY ZEROS.
IF (ALL-23 NOT NUMERIC) OR (NUM-IT-2 > 12) OR (NUM-IT-2 = ZERO)
MOVE 50 TO J
PERFORM CURSOR
DISPLAY " BAD SWITCH"
MOVE 42 TO J
PERFORM CURSOR
GO TO ACCEPT-CHG.
MOVE NUM-IT-2 TO L.
ADD 2 TO L.
PERFORM CLEAN-IT.
GO TO LOOP-VALUE.
CLEAN-IT.
MOVE 45 TO J.
PERFORM CURSOR.
PERFORM CLEAR-LINE.
MOVE 1 TO J.
PERFORM CURSOR.
DISPLAY THE-NUMBER THE-TUBE (K) WITH NO ADVANCING.
COMMENT-CHECK.
MOVE DATA-A (K) TO THE-DATA.
IF DATA-1 NOT = "*"
GO TO EDIT-IT.
PERFORM CLEAR-SCREEN.
IF THE-ACTION = "CHG"
DISPLAY "OLD COM" STAR-COMMENT.
DISPLAY " 1 1 2 2 3 3 4 4 5 5 6 6 7 7".
DISPLAY " 8901234567890123456789012345678901234567890123456789012345678901234".
DISPLAY "NEW COM" WITH NO ADVANCING ACCEPT THE-COMMENT.
MOVE PROG-COMMENT TO PROG-INFO.
IF THE-ACTION = "CHG"
PERFORM CHG-REC THRU END-CHG-REC
PERFORM CLEAR-SCREEN
GO TO END-IT.
GO TO END-VALUE.
BAD-NUMBER.
MOVE 23 TO I.
MOVE 20 TO J.
PERFORM CURSOR
DISPLAY "BAD NUMBER " ELE-NUM.
FIND-REC.
OPEN I-O PROGRAM-FILE.
MOVE 1 TO PROGRAM-KEY.
READ PROGRAM-FILE INVALID KEY
DISPLAY "BAD READ CHG FILE " PROGRAM-KEY STOP RUN.
MOVE PROGRAM-RECORD TO PROGRAM-ZERO.
LOOP-CHG.
ADD 1 TO PROGRAM-KEY.
IF PROGRAM-KEY > PROGRAM-LAST-REC
DISPLAY "LOGIC ERROR IN PROGRAM" STOP RUN.
READ PROGRAM-FILE INVALID KEY
DISPLAY "BAD READ CHG FILE " PROGRAM-KEY STOP RUN.
MOVE PROGRAM-RECORD TO PROGRAM-MAIN.
IF PROGRAM-PAGE NOT = THE-PAGE GO TO LOOP-CHG.
IF PROGRAM-LINE NOT = THE-LINE GO TO LOOP-CHG.
MOVE PROGRAM-INFO TO PROG-INFO.
MOVE OBJ-OUT TO DATA-A (1).
MOVE LIS-OPT TO DATA-A (2).
MOVE COR-SIZ TO DATA-A (3).
MOVE DEBUG TO DATA-A (4).
MOVE INV-PRI TO DATA-A (5).
MOVE ACT-COL TO DATA-A (6).
MOVE INQ TO DATA-A (7).
MOVE 1P-FOR TO DATA-A (8).
MOVE FIL-TRA TO DATA-A (9).
MOVE PUN-MFC TO DATA-A (10).
MOVE NON-CHA TO DATA-A (11).
MOVE SHA-I-O TO DATA-A (12).
END-FIND-REC.
EXIT.
CHG-REC.
MOVE PROG-INFO TO PROGRAM-INFO.
MOVE PROGRAM-MAIN TO PROGRAM-RECORD.
WRITE PROGRAM-RECORD INVALID KEY
DISPLAY "BAD WRITE CHG " PROGRAM-KEY STOP RUN.
CLOSE PROGRAM-FILE.
END-CHG-REC.
EXIT.
ADD-IT.
MOVE 3 TO I.
MOVE I TO L.
LOOP-VALUE.
ADD 1 TO L.
IF L > 15 GO TO END-VALUE.
MOVE L TO I.
GO TO BY-NUM.
END-VALUE.
PERFORM CLEAR-SCREEN.
PERFORM WRITE-ADD THRU END-WRITE-ADD.
GO TO END-IT.
CURSOR.
IF THE-TERM = "A" ENTER MACRO CURSER USING I,J.
IF THE-TERM = "D" ENTER MACRO CA1520 USING I,J.
IF THE-TERM = "V" ENTER MACRO CAVT52 USING I,J.
IF THE-TERM = "3" ENTER MACRO CA3300 USING I,J.
IF THE-TERM = "B" ENTER MACRO CAB100 USING I,J.
CLEAR-SCREEN.
IF THE-TERM = "A" OR "D"
ENTER MACRO TTYOUT USING 14.
IF THE-TERM = "V"
ENTER MACRO CLVT52.
IF THE-TERM = "3"
ENTER MACRO TTYOUT USING 35,37,37,37,37.
IF THE-TERM = "B"
ENTER MACRO CLB100.
CLEAR-LINE.
IF THE-TERM = "A" OR "V" OR "B"
DISPLAY CLEAR-IT WITH NO ADVANCING.
IF THE-TERM = "D"
ENTER MACRO TTYOUT USING 35.
IF THE-TERM = "3"
DISPLAY CLEAR-3300 WITH NO ADVANCING.
THE-EDIT.
IF K = 1 PERFORM EDIT-1 THRU END-EDIT-1.
IF K = 2 PERFORM EDIT-2 THRU END-EDIT-2.
IF K = 3 PERFORM EDIT-3 THRU END-EDIT-3.
IF K = 4 PERFORM EDIT-4 THRU END-EDIT-4.
IF K = 5 PERFORM EDIT-5 THRU END-EDIT-5.
IF K = 6 PERFORM EDIT-6 THRU END-EDIT-6.
IF K = 7 PERFORM EDIT-7 THRU END-EDIT-7.
IF K = 8 PERFORM EDIT-8 THRU END-EDIT-8.
IF K = 9 PERFORM EDIT-9 THRU END-EDIT-9.
IF K = 10 PERFORM EDIT-10 THRU END-EDIT-10.
IF K = 11 PERFORM EDIT-11 THRU END-EDIT-11.
IF K = 12 PERFORM EDIT-12 THRU END-EDIT-12.
EDIT-1.
MOVE DATA-A (1) TO THE-DATA.
IF DATA-1 = SPACE OR "D" OR "C" OR "P" OR "R" OR "T" OR "B"
MOVE DATA-1 TO OBJ-OUT
MOVE OBJ-OUT TO DATA-A (1)
GO TO END-EDIT-1.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , ,D,C,P,R,T, OR B".
MOVE "X" TO ERROR-CODE.
END-EDIT-1.
EXIT.
EDIT-2.
MOVE DATA-A (2) TO THE-DATA.
IF DATA-1 = SPACE OR "B" OR "P"
MOVE DATA-1 TO LIS-OPT
MOVE LIS-OPT TO DATA-A (2)
GO TO END-EDIT-2.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , ,B, OR P".
MOVE "X" TO ERROR-CODE.
END-EDIT-2.
EXIT.
EDIT-3.
MOVE DATA-A (3) TO THE-DATA.
IF THE-DATA = SPACES
MOVE THE-DATA TO COR-SIZ
MOVE COR-SIZ TO DATA-A (3)
GO TO END-EDIT-3.
IF DATA-1 = SPACE OR ZERO OR "Q" OR "H" OR "T" GO TO CHECK-CORE.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , ,0,Q,H, OR T".
MOVE "X" TO ERROR-CODE.
GO TO END-EDIT-3.
CHECK-CORE.
MOVE DATA-2 TO NUM-IT-2.
EXAMINE DATA-2 REPLACING ALL SPACES BY ZEROS.
IF DATA-2 NOT NUMERIC GO TO ERROR-3.
IF (NUM-IT-2 > ZERO) AND (NUM-IT-2 < 62)
MOVE NUM-IT-2 TO SIZ-COR
MOVE COR-SIZ TO DATA-A (3)
GO TO END-EDIT-3.
ERROR-3.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER > ZERO AND < 61".
MOVE "X" TO ERROR-CODE.
END-EDIT-3.
EXIT.
EDIT-4.
MOVE DATA-A (4) TO THE-DATA.
IF DATA-1 = SPACE OR "1"
MOVE DATA-1 TO DEBUG
MOVE DEBUG TO DATA-A (4)
GO TO END-EDIT-4.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , , OR 1".
MOVE "X" TO ERROR-CODE.
END-EDIT-4.
EXIT.
EDIT-5.
MOVE DATA-A (5) TO THE-DATA.
IF DATA-1 = SPACE OR "I" OR "J" OR "D"
MOVE DATA-1 TO INV-PRI
MOVE INV-PRI TO DATA-A (5)
GO TO END-EDIT-5.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , ,I,J, OR D".
MOVE "X" TO ERROR-CODE.
END-EDIT-5.
EXIT.
EDIT-6.
MOVE DATA-A (6) TO THE-DATA.
IF DATA-1 = SPACE OR "S"
MOVE DATA-1 TO ACT-COL
MOVE ACT-COL TO DATA-A (6)
GO TO END-EDIT-6.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , , OR S".
MOVE "X" TO ERROR-CODE.
END-EDIT-6.
EXIT.
EDIT-7.
MOVE DATA-A (7) TO THE-DATA.
IF DATA-1 = SPACE OR "B" OR "I"
MOVE DATA-1 TO INQ
MOVE INQ TO DATA-A (7)
GO TO END-EDIT-7.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , ,B, OR I".
MOVE "X" TO ERROR-CODE.
END-EDIT-7.
EXIT.
EDIT-8.
MOVE DATA-A (8) TO THE-DATA.
IF DATA-1 = SPACE OR "1"
MOVE DATA-1 TO 1P-FOR
MOVE 1P-FOR TO DATA-A (8)
GO TO END-EDIT-8.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , , OR 1".
MOVE "X" TO ERROR-CODE.
END-EDIT-8.
EXIT.
EDIT-9.
MOVE DATA-A (9) TO THE-DATA.
IF DATA-1 = SPACE OR "F"
MOVE DATA-1 TO FIL-TRA
MOVE FIL-TRA TO DATA-A (9)
GO TO END-EDIT-9.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , , OR F".
MOVE "X" TO ERROR-CODE.
END-EDIT-9.
EXIT.
EDIT-10.
MOVE DATA-A (10) TO THE-DATA.
IF DATA-1 = SPACE OR "1"
MOVE DATA-1 TO PUN-MFC
MOVE PUN-MFC TO DATA-A (10)
GO TO END-EDIT-10.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTER , , OR 1".
MOVE "X" TO ERROR-CODE.
END-EDIT-10.
EXIT.
EDIT-11.
MOVE DATA-A (11) TO THE-DATA.
IF DATA-1 = SPACE OR "1"
MOVE DATA-1 TO NON-CHA
MOVE NON-CHA TO DATA-A (11)
GO TO END-EDIT-11.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTRY NOT , , OR 1".
MOVE "X" TO ERROR-CODE.
END-EDIT-11.
EXIT.
EDIT-12.
MOVE DATA-A (12) TO THE-DATA.
IF DATA-1 = SPACE OR "1"
MOVE DATA-1 TO SHA-I-O
MOVE SHA-I-O TO DATA-A (12)
GO TO END-EDIT-12.
MOVE 50 TO J.
PERFORM CURSOR.
DISPLAY " ENTRY NOT , , OR 1".
MOVE "X" TO ERROR-CODE.
END-EDIT-12.
EXIT.
WRITE-ADD.
OPEN I-O PROGRAM-FILE.
MOVE 1 TO PROGRAM-KEY.
READ PROGRAM-FILE INVALID KEY
DISPLAY "BAD READ " PROGRAM-KEY STOP RUN.
MOVE PROGRAM-RECORD TO PROGRAM-ZERO.
MOVE PROGRAM-LAST-REC TO PROGRAM-REC-NO PROGRAM-ACT-REC.
ADD 1 TO PROGRAM-LAST-REC.
MOVE PROGRAM-LAST-REC TO PROGRAM-KEY.
MOVE THE-FILE TO PROGRAM-IDENT.
MOVE THE-PAGE TO PROGRAM-PAGE.
MOVE THE-LINE TO PROGRAM-LINE.
MOVE "H" TO PROGRAM-FORM.
MOVE PROG-INFO TO PROGRAM-INFO.
MOVE PROGRAM-MAIN TO PROGRAM-RECORD.
WRITE-ADD-A.
WRITE PROGRAM-RECORD INVALID KEY
DISPLAY "BAD WRITE " PROGRAM-KEY STOP RUN.
MOVE 1 TO PROGRAM-KEY.
MOVE PROGRAM-ZERO TO PROGRAM-RECORD.
WRITE PROGRAM-RECORD INVALID KEY
DISPLAY "BAD WRITE " PROGRAM-KEY STOP RUN.
CLOSE PROGRAM-FILE.
END-WRITE-ADD.
EXIT.
END-IT.
MOVE PROGRAM-NAME TO THE-FILE.
MOVE "RPGSYS" TO NEXT-PROGRAM.
ENTER MACRO SYSPRG USING NEXT-PROGRAM, PASS-IT.
END-PROGRAM.
STOP RUN.