Trailing-Edge
-
PDP-10 Archives
-
iqlv30
-
iqes.cbl
There are 2 other files named iqes.cbl in the archive. Click here to see a list.
001000 IDENTIFICATION DIVISION.
001020
001040 PROGRAM-ID. IQES.
001060
001080 SECURITY. COPYRIGHT 1976 1977 1978 AZREX INC.
001100
001120 REMARKS. IQES10 IS THE SORT-CALL MODULE OF IQL3.0
001140
002000 ENVIRONMENT DIVISION.
002020 CONFIGURATION SECTION.
002040 SOURCE-COMPUTER. DECSYSTEM-10.
002060 OBJECT-COMPUTER. DECSYSTEM-10.
002080
002100 INPUT-OUTPUT SECTION.
002120 FILE-CONTROL.
002140
002160 SELECT CMD-FILE
002180 ASSIGN TO DSK
002200 RECORDING MODE IS BINARY.
002220
002240 I-O-CONTROL.
002260
003000 DATA DIVISION.
003020
003100 FILE SECTION.
003120
003200 FD CMD-FILE
003220 VALUE OF IDENTIFICATION IS TEMPNAME
003240 USER-NUMBER IS PPN
003260 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS
003280 DATA RECORD IS CMD-FILE-REC.
003300 01 CMD-FILE-REC USAGE IS DISPLAY-7 PICTURE X(80).
003320
003340
004000 WORKING-STORAGE SECTION.
004020
004100 01 JOB-NO PICTURE S9(10) COMP VALUE 0.
004200 01 PPN PICTURE S9(10) COMP VALUE 0.
004300 01 SORTNAME.
004310 02 FILLER PIC X(12) VALUE 'SYS '.
004320 02 FILLER PIC X(12) VALUE 'SORT '.
004500 01 INFOBLOCK.
004600 02 RN-DEV PIC X(06).
004610 02 RN-PPN PIC X(06).
004620 02 RN-PRG PIC X(06).
004700 02 RN-NAM PIC X(06).
004800 01 TEMPNAME.
004900 02 TEMP-NUM PIC X(3) VALUE '000'.
005000 02 FILLER PIC X(6) VALUE 'SRTTMP'.
005100 01 TMPCOR-SIZE PICTURE S9(10) COMP.
005200 01 TMPCOR-BLOCK DISPLAY-7.
005300 02 FILLER PIC X(02) VALUE IS 'QT'.
005400 02 OUTNUM PIC 9(03) VALUE IS 0.
005500 02 FILLER PIC X(08) VALUE IS 'S.TMP=QT'.
005600 02 INPNUM PIC 9(03) VALUE IS 0.
005700 02 FILLER PIC X(20) VALUE IS 'S.TMP/SIXBIT/RECORD:'.
005800 02 RECSIZE PIC 9(04) VALUE IS 0.
005900 02 FILLER PIC X(05) VALUE IS '/KEY:'.
006000 02 KEYOFFS PIC 9(04) VALUE IS 0.
006100 02 FILLER PIC X VALUE IS ':'.
006200 02 KEYSIZE PIC 9(04) VALUE IS 0.
006250 02 FILLER PIC X(12) VALUE '/RUNOFFSET:0'.
006300 02 FILLER PIC X(05) VALUE '/RUN:'.
006400 02 RUNDEV PIC X(03) VALUE 'SYS'.
006500 02 FILLER PIC X(04) VALUE ':IQE'.
006600 02 CRLF PIC X(02).
006620
007100 LINKAGE SECTION.
007200 01 P-RECSIZE PIC S9(10) COMP.
007300 01 P-KEYOFFS PIC S9(10) COMP.
007400 01 P-KEYSIZE PIC S9(10) COMP.
007420
007440
010000 PROCEDURE DIVISION.
010020 ENTRY IQES1 USING P-RECSIZE, P-KEYOFFS, P-KEYSIZE.
010040
010100 DOIT.
010120 ENTER MACRO IQGJOB USING JOB-NO.
010140 MOVE JOB-NO TO TEMP-NUM INPNUM OUTNUM.
010160 MOVE P-RECSIZE TO RECSIZE.
010180 MOVE P-KEYOFFS TO KEYOFFS.
010200 MOVE P-KEYSIZE TO KEYSIZE.
010220 ENTER MACRO IQWHOX USING INFOBLOCK.
010240 IF RN-DEV NOT = ' '
010245 MOVE RN-DEV TO RUNDEV.
010260 ENTER MACRO IQCRLF USING CRLF.
010280 MOVE 16 TO TMPCOR-SIZE.
010300 ENTER MACRO IQWTMP USING TEMPNAME, TMPCOR-SIZE, TMPCOR-BLOCK.
010320 IF TMPCOR-SIZE > 0 GO TO DONE.
010340
010400* *TMPCOR FAILED. WRITE DISK FILE.
010420 OPEN OUTPUT CMD-FILE.
010440 WRITE CMD-FILE-REC FROM TMPCOR-BLOCK.
010460 CLOSE CMD-FILE.
010540
010600 DONE.
010620 ENTER MACRO IQRUN1 USING SORTNAME.
010630 DISPLAY '?RUN SORT FAILED'.
010640 EXIT PROGRAM.
010660