144 lines
4.9 KiB
COBOL
144 lines
4.9 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. "WOPO-CNF".
|
|
|
|
ENVIRONMENT DIVISION.
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT CONFIG
|
|
ASSIGN TO DISK
|
|
ORGANIZATION IS INDEXED
|
|
ACCESS MODE IS RANDOM
|
|
RECORD KEY IS CONFIG-KEY.
|
|
SELECT USERS
|
|
ASSIGN TO DISK
|
|
ORGANIZATION IS INDEXED
|
|
ACCESS MODE IS RANDOM
|
|
RECORD KEY IS USER-NAME.
|
|
SELECT CHANNELS
|
|
ASSIGN TO DISK
|
|
ORGANIZATION IS SEQUENTIAL.
|
|
SELECT PROGRAM-INDEX
|
|
ASSIGN TO DISK
|
|
ORGANIZATION IS INDEXED
|
|
ACCESS MODE IS RANDOM
|
|
RECORD KEY IS NAME OF INDEX-ENTRY.
|
|
SELECT PROGRAM-CODE
|
|
ASSIGN TO DISK
|
|
ORGANIZATION IS RELATIVE
|
|
ACCESS MODE IS SEQUENTIAL
|
|
RELATIVE KEY IS PROGRAM-IP.
|
|
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD CONFIG.
|
|
01 CONFIG-RECORD.
|
|
03 CONFIG-KEY PIC X(16).
|
|
03 CONFIG-VALUE PIC X(64).
|
|
FD USERS.
|
|
01 USER-RECORD.
|
|
03 USER-NAME PIC X(40).
|
|
03 USER-LEVEL PIC 9(2).
|
|
FD CHANNELS.
|
|
01 CHANNEL-RECORD.
|
|
03 CHANNEL-NAME PIC X(50).
|
|
FD PROGRAM-INDEX.
|
|
01 INDEX-ENTRY.
|
|
03 NAME PIC X(16).
|
|
03 ADDR PIC 999.
|
|
FD PROGRAM-CODE.
|
|
01 PROGRAM-RECORD.
|
|
03 INSTRUCTION PIC X(999).
|
|
03 PREV-IP PIC 999.
|
|
03 NEXT-IP PIC 999.
|
|
|
|
WORKING-STORAGE SECTION.
|
|
01 STATE PIC 9(2) VALUE 0.
|
|
88 WRITING-PROGRAM VALUE 10.
|
|
88 DONE VALUE 99.
|
|
01 CURRENT-INSTRUCTION.
|
|
03 INSTRUCTION PIC X(999).
|
|
03 PREV-IP PIC 999.
|
|
03 NEXT-IP PIC 999.
|
|
01 PROGRAM-IP PIC 999.
|
|
|
|
PROCEDURE DIVISION.
|
|
DISPLAY "WOPO CONFIGURATION PROGRAM".
|
|
DISPLAY "BLANK ENTRY TO EXIT SECTION".
|
|
DISPLAY "WRITING CONFIGURATION ENTRIES:".
|
|
OPEN OUTPUT CONFIG.
|
|
MOVE 0 TO STATE.
|
|
PERFORM WRITE-CONFIG-ENTRY UNTIL DONE.
|
|
CLOSE CONFIG.
|
|
DISPLAY "WRITING USER ENTRIES:"
|
|
OPEN OUTPUT USERS.
|
|
MOVE 0 TO STATE.
|
|
PERFORM WRITE-USER-ENTRY UNTIL DONE.
|
|
CLOSE USERS.
|
|
OPEN OUTPUT CHANNELS.
|
|
DISPLAY "WRITING CHANNEL AUTOJOINS:"
|
|
MOVE 0 TO STATE.
|
|
PERFORM WRITE-CHANNEL-ENTRY UNTIL DONE.
|
|
CLOSE CHANNELS.
|
|
OPEN OUTPUT PROGRAM-INDEX, PROGRAM-CODE.
|
|
DISPLAY "WRITING PROGRAMS."
|
|
MOVE 0 TO STATE.
|
|
PERFORM WRITE-PROGRAM UNTIL DONE.
|
|
CLOSE PROGRAM-INDEX, PROGRAM-CODE.
|
|
CALL "PRINT-CONFIG".
|
|
STOP RUN.
|
|
|
|
WRITE-CONFIG-ENTRY.
|
|
ACCEPT CONFIG-RECORD.
|
|
IF CONFIG-RECORD IS EQUAL TO SPACES
|
|
THEN MOVE 99 TO STATE
|
|
ELSE WRITE CONFIG-RECORD.
|
|
|
|
WRITE-USER-ENTRY.
|
|
ACCEPT USER-RECORD.
|
|
IF USER-NAME IS EQUAL TO SPACES OR USER-LEVEL IS EQUAL TO 0
|
|
THEN MOVE 99 TO STATE
|
|
ELSE WRITE USER-RECORD.
|
|
|
|
WRITE-CHANNEL-ENTRY.
|
|
ACCEPT CHANNEL-NAME.
|
|
IF CHANNEL-NAME IS EQUAL TO SPACES
|
|
THEN MOVE 99 TO STATE
|
|
ELSE WRITE CHANNEL-RECORD.
|
|
|
|
WRITE-PROGRAM.
|
|
ACCEPT NAME OF INDEX-ENTRY.
|
|
IF NAME OF INDEX-ENTRY IS EQUAL TO SPACES THEN
|
|
D DISPLAY "DONE WRITING PROGRAMS."
|
|
MOVE 99 TO STATE
|
|
ELSE
|
|
D DISPLAY "WRITING PROGRAM ", NAME OF INDEX-ENTRY, "."
|
|
COMPUTE ADDR OF INDEX-ENTRY = PROGRAM-IP + 1
|
|
WRITE INDEX-ENTRY
|
|
MOVE SPACES TO INSTRUCTION OF PROGRAM-RECORD,
|
|
INSTRUCTION OF CURRENT-INSTRUCTION
|
|
PERFORM WRITE-PROGRAM-RECORD UNTIL DONE
|
|
MOVE 0 TO STATE.
|
|
|
|
WRITE-PROGRAM-RECORD.
|
|
ACCEPT INSTRUCTION OF CURRENT-INSTRUCTION.
|
|
IF INSTRUCTION OF CURRENT-INSTRUCTION IS EQUAL TO SPACES THEN
|
|
D DISPLAY "DONE WRITING PROGRAM ",
|
|
D NAME OF INDEX-ENTRY, "."
|
|
MOVE 999 TO NEXT-IP OF PROGRAM-RECORD
|
|
MOVE 99 TO STATE
|
|
ELSE
|
|
D DISPLAY "ACCEPTED INSTRUCTION. ",
|
|
D INSTRUCTION OF CURRENT-INSTRUCTION
|
|
COMPUTE NEXT-IP IN PROGRAM-RECORD = PROGRAM-IP + 2
|
|
IF WRITING-PROGRAM THEN
|
|
COMPUTE PREV-IP OF CURRENT-INSTRUCTION =
|
|
PROGRAM-IP + 1
|
|
ELSE
|
|
MOVE 0 TO PREV-IP OF CURRENT-INSTRUCTION.
|
|
IF INSTRUCTION OF PROGRAM-RECORD IS NOT EQUAL TO SPACES THEN
|
|
D DISPLAY "WRITING INSTRUCTION. ", PROGRAM-RECORD
|
|
WRITE PROGRAM-RECORD
|
|
IF NOT DONE THEN
|
|
MOVE 10 TO STATE.
|
|
MOVE CURRENT-INSTRUCTION TO PROGRAM-RECORD.
|