Google
 

Trailing-Edge - PDP-10 Archives - iqlv30 - iqes10.cbl
There are no other files named iqes10.cbl in the archive.
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