Google
 

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.