Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50232/cobque.cbl
There are no other files named cobque.cbl in the archive.
IDENTIFICATION DIVISION.
PROGRAM-ID. SYSTEM-QUEUER.
REMARKS.
PROGRAM TO SET UP A PARMETER AREA AND THEN CALL THE
SYSTEM QUE MANGER. ENTERS DDT IF AN UNKNOWN
RETURN IS RECEIVED OR IF "DDT" IS ENTERED FOR A
COMMAND. [DDT EXECUTION IS DEPENEDED ON THE LOADING
OF DDT FORM THE SYSTEM LIBRARY].
*** DEVELOPED AS A QUEUE MANIPULATOR FOR REYNOLDS AND REYNOLDS ***
AUTHOR. DAVID RICHARD KIARSIS.
INSTALLATION. REYNOLDS AND REYNOLDS.
DATE-WRITTEN. 13-JAN-72.
DATE-COMPILED. 13-JAN-72.
SECURITY. TOP-SECRET.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PDP-10.
OBJECT-COMPUTER. PDP-10.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 QUE-ARGUMENTS.
02 QUE-FLAG PIC X(12).
02 QUE-OP PIC X(6).
02 QUE-NAME PIC X(6).
02 QUE-FILE PIC X(6).
02 QUE-EXT PIC X(6).
02 QUE-PROJ PIC X(6).
02 QUE-PROG PIC X(6).
02 QUE-PRIORITY PIC S9(2) COMP.
01 RESPONSE.
02 INP OCCURS 100 TIMES PIC X.
01 SEARCH-CHARACTER PIC X.
01 SEARCH-WORD.
02 WORD OCCURS 6 TIMES PIC X.
01 COM-CHECK PIC X(3).
77 SEARCH-COUNT PIC 999 COMP.
77 I PIC 999 COMP.
77 J PIC 999 COMP.
PROCEDURE DIVISION.
START-THE-RUN.
DISPLAY "QUEUE MANGER HERE".
GO TO BEGIN.
NEXT-TIME-HERE.
DISPLAY " ".
BEGIN.
DISPLAY "> _".
ACCEPT RESPONSE.
IF RESPONSE EQUALS SPACES GO TO BEGIN.
MOVE RESPONSE TO COM-CHECK.
IF COM-CHECK EQUALS "STO" OR "EXI"
GO TO END-THE-RUN.
IF COM-CHECK EQUALS "DDT" OR "DEB"
GO TO FIX-LITTLE-BUG.
GET-THE-OPCODE.
MOVE 1 TO J.
MOVE " " TO SEARCH-CHARACTER.
MOVE 6 TO SEARCH-COUNT.
PERFORM ISOLATE-THE-FIELD THRU RET.
MOVE SEARCH-WORD TO COM-CHECK.
IF COM-CHECK EQUALS "QUE"
MOVE "QUE" TO SEARCH-WORD
GO TO GET-THE-QUE-NAME.
IF COM-CHECK EQUALS "FIN"
MOVE "FIND" TO SEARCH-WORD
GO TO GET-THE-QUE-NAME.
IF COM-CHECK EQUALS "ABO"
MOVE "ABORT" TO SEARCH-WORD
GO TO GET-THE-QUE-NAME.
DISPLAY "UNKNOWN COMMAND SPECIFIED."
GO TO NEXT-TIME-HERE.
GET-THE-QUE-NAME.
MOVE SEARCH-WORD TO QUE-OP.
MOVE ":" TO SEARCH-CHARACTER.
MOVE 3 TO SEARCH-COUNT.
PERFORM ISOLATE-THE-FIELD THRU RET.
IF SEARCH-WORD EQUALS SPACES
DISPLAY "NO QUEUE SPECIFIED."
GO TO NEXT-TIME-HERE.
IF SEARCH-WORD EQUALS "INP"
GO TO GET-THE-FILE-NAME.
IF SEARCH-WORD EQUALS "LPT"
GO TO GET-THE-FILE-NAME.
IF SEARCH-WORD EQUALS "PTP"
GO TO GET-THE-FILE-NAME.
DISPLAY "UNKNOW QUEUE NAME SPECIFIED."
GO TO NEXT-TIME-HERE.
GET-THE-FILE-NAME.
MOVE SEARCH-WORD TO QUE-NAME.
MOVE "." TO SEARCH-CHARACTER.
MOVE 6 TO SEARCH-COUNT.
PERFORM ISOLATE-THE-FIELD THRU RET.
IF SEARCH-WORD EQUALS SPACES
DISPLAY "ILLEGAL FILE NAME."
GO TO NEXT-TIME-HERE.
MOVE SEARCH-WORD TO QUE-FILE.
GET-THE-EXTENSION.
MOVE "[" TO SEARCH-CHARACTER.
MOVE 3 TO SEARCH-COUNT.
PERFORM ISOLATE-THE-FIELD THRU RET.
MOVE SEARCH-WORD TO QUE-EXT.
GET-THE-QUE-PROJ.
IF INP (J) EQUALS "["
ADD 1 TO J.
MOVE "," TO SEARCH-CHARACTER.
MOVE 6 TO SEARCH-COUNT.
PERFORM ISOLATE-THE-FIELD THRU RET.
MOVE SEARCH-WORD TO QUE-PROJ.
GET-THE-QUE-PROG.
MOVE "]" TO SEARCH-CHARACTER.
MOVE 6 TO SEARCH-COUNT.
PERFORM ISOLATE-THE-FIELD THRU RET.
MOVE SEARCH-WORD TO QUE-PROG.
FIND-QMANGR.
ENTER MACRO COBQUE USING QUE-ARGUMENTS.
CHECK-FOR-ERRORS.
IF QUE-FLAG EQUALS "ON DEVICE"
DISPLAY "REQUEST IS IN PROGRESS."
GO TO NEXT-TIME-HERE.
IF QUE-FLAG EQUALS "NOT PENDING"
DISPLAY "REQUEST WAS NOT FOUND IN QUEUES."
GO TO NEXT-TIME-HERE.
IF QUE-FLAG EQUALS "PENDING"
DISPLAY "REQUEST IS PENDING EXECUTION."
GO TO NEXT-TIME-HERE.
IF QUE-FLAG EQUALS "QUEUED"
DISPLAY "***JOB ACCEPTED"
GO TO NEXT-TIME-HERE.
IF QUE-FLAG EQUALS "INTERLOCKED"
DISPLAY "REQUEST INTERLOCKED IN MASTER QUEUE."
GO TO NEXT-TIME-HERE.
IF QUE-FLAG EQUALS "KILLED"
DISPLAY "***JOB ABORTED"
GO TO NEXT-TIME-HERE.
IF QUE-FLAG EQUALS "ERROR"
DISPLAY "UNABLE TO PROCESS REQUEST."
GO TO NEXT-TIME-HERE.
IF QUE-FLAG EQUALS "FAILURE"
DISPLAY "***SYSTEM ABORTED REQUEST"
GO TO NEXT-TIME-HERE.
IF QUE-FLAG EQUALS "NOT SAVED"
MOVE QUE-FILE TO SEARCH-WORD
DISPLAY "FILE ",QUOTE,"_"
PERFORM DISPLAY-SEARCH-WORD THRU RET
MOVE QUE-EXT TO SEARCH-WORD
PERFORM CHECK-FOR-NULLS
PERFORM DISPLAY-SEARCH-WORD THRU RET
DISPLAY QUOTE," IS NOT SAVED."
GO TO NEXT-TIME-HERE.
DISPLAY "***UNKNOW RETURN --> ",QUE-FLAG.
FIX-LITTLE-BUG.
DISPLAY " ".
DISPLAY "DEBUGGER HERE_".
ENTER MACRO DDT.
RETURN-FROM-LITTLE-BUG.
DISPLAY " ".
DISPLAY "RETURN FROM BUG".
GO TO BEGIN.
CHECK-FOR-NULLS.
IF SEARCH-WORD IS NOT EQUAL TO SPACES
DISPLAY "._".
DISPLAY-SEARCH-WORD.
MOVE 1 TO I.
NEXT-CHARACTER.
IF WORD (I) EQUALS " "
GO TO RET.
DISPLAY WORD (I),"_".
IF I EQUALS 6 GO TO RET.
ADD 1 TO I.
GO TO NEXT-CHARACTER.
ISOLATE-THE-FIELD.
MOVE SPACES TO SEARCH-WORD.
MOVE 1 TO I.
MOVE-THE-STRING.
IF J EQUALS 100 GO TO RET.
IF INP (J) EQUALS "[" GO TO RET.
IF INP (J) EQUALS SEARCH-CHARACTER OR "["
ADD 1 TO J GO TO RET.
SUBTRACT 1 FROM I.
IF I EQUALS SEARCH-COUNT
ADD 1 TO J
ADD 1 TO I
GO TO MOVE-THE-STRING.
ADD 1 TO I.
IF INP (J) EQUALS " "
ADD 1 TO J
GO TO MOVE-THE-STRING.
MOVE INP (J) TO WORD (I).
ADD 1 TO I.
ADD 1 TO J.
GO TO MOVE-THE-STRING.
RET.
EXIT.
END-THE-RUN.
DISPLAY "***JOB ENDED".
STOP RUN.