* $$ JOB JNM=FCB,CLASS=V,DISP=L,PRI=3 * $$ LST CLASS=O,DISP=D,JSEP=0,DEST=(*,BILLB) // JOB FCB // EXEC LIBR ACC S=TSTLIB.WHB IDENTIFICATION DIVISION. PROGRAM-ID. FCB. AUTHOR. BILL BLASINGIM. REMARKS. THIS PROGRAM GENERATES AN FCB. DATE-WRITTEN. OCT. 22, 1992. DATE-COMPILED. ENVIRONMENT DIVISION. CONFIGURATION SECTION. INPUT-OUTPUT SECTION. FILE-CONTROL. * SELECT CARD-IN ASSIGN TO SYS010-UR-3525R-S. SELECT PUNCH-OUT ASSIGN TO SYS040-UR-3525P-S. DATA DIVISION. FILE SECTION. FD PUNCH-OUT LABEL RECORDS OMITTED. 01 PUNCH-REC. 05 FILLER PIC X(80). WORKING-STORAGE SECTION. 01 WORK-AREA. 05 CHANNEL-NO PIC S9(4) VALUE +0 COMP. 05 CURRENT-LINE PIC S9(3) VALUE +1 COMP-3. 05 LINES-PER-PAGE PIC S9(3) VALUE +0 COMP-3. 05 FCB-LINE PIC S9(3) VALUE +0 COMP-3. 05 HEX-DIGITS PIC X(16) VALUE '0123456789ABCDEF'. 05 FILLER REDEFINES HEX-DIGITS. 10 HEX-BYTE PIC X(01) OCCURS 16 TIMES. 05 DEFINE-CONSTANT. 10 FILLER PIC X(16) VALUE ' DC XL'. 10 DC-LEN PIC 9(03). 10 FILLER PIC X VALUE QUOTE. 10 DC-HEX. 15 BYTE1 PIC X VALUE '0'. 15 BYTE2 PIC X VALUE '0'. 10 FILLER PIC X VALUE QUOTE. 01 CARD-IN. 05 CARD-LINE PIC X(50). 05 FILLER REDEFINES CARD-LINE. 10 PHASE-NAME PIC X(08). 10 FILLER PIC X(42). 05 FILLER REDEFINES CARD-LINE. 10 L-P-P PIC X(03). 10 FILLER PIC X(47). 05 FILLER REDEFINES CARD-LINE. 10 LINES-PER-INCH PIC X(01). 10 FILLER PIC X(49). 05 FILLER REDEFINES CARD-LINE. 10 CHANNEL PIC X(02). 10 FILLER PIC X(01). 10 LINE-NO PIC X(03). 10 FILLER PIC X(44). 01 JCL-LINES. 05 FILLER PIC X(80) VALUE '* $$ JOB JNM=FCB,CLASS=P,DISP=D'. 05 FILLER PIC X(80) VALUE '* $$ LST CLASS=L,DISP=L'. 05 FILLER PIC X(80) VALUE '// JOB FCB'. 05 FILLER PIC X(80) VALUE '// OPTION CATAL,NODECK'. 05 FILLER PIC X(80) VALUE '// LIBDEF PHASE,CATALOG=TESTLIB.USER'. 05 FILLER. 10 FILLER PIC X(08) VALUE ' PHASE '. 10 PHASE-NAME-COMMA-ASTRIK PIC X(10). 10 FILLER PIC X(62) VALUE SPACES. 05 FILLER PIC X(80) VALUE '// EXEC ASSEMBLY'. 05 FILLER PIC X(80) VALUE ' START 0'. * * FCB ASSEMBLER CODE GOES HERE * 05 FILLER. 10 FILLER PIC X(25) VALUE ' DC CL80''PHASE '. 10 PHASE-OUT PIC X(08). 10 FILLER PIC X(08) VALUE ' LOADED'''. 10 FILLER PIC X(39) VALUE SPACES. 05 FILLER PIC X(80) VALUE ' END'. 05 FILLER PIC X(80) VALUE '/*'. 05 FILLER PIC X(80) VALUE '// EXEC LNKEDT'. 05 FILLER PIC X(80) VALUE '/*'. 05 FILLER PIC X(80) VALUE '/&'. 05 FILLER PIC X(80) VALUE '* $$ EOJ'. 01 FILLER REDEFINES JCL-LINES. 05 JCL-LINE PIC X(80) OCCURS 15 TIMES INDEXED BY INDEX-1. PROCEDURE DIVISION. OPEN OUTPUT PUNCH-OUT. * GET PHASE NAME ACCEPT CARD-IN. MOVE PHASE-NAME TO PHASE-OUT. STRING PHASE-NAME ',*' DELIMITED BY SPACE INTO PHASE-NAME-COMMA-ASTRIK. * GET LINES PER INCH ACCEPT CARD-IN. IF LINES-PER-INCH = '8' THEN MOVE '1' TO BYTE1. * GET NO OF LINES ACCEPT CARD-IN. IF L-P-P NOT NUMERIC THEN DISPLAY '* ERROR - # OF LINES INVALID *' GO TO EOJ-RTN. MOVE L-P-P TO LINES-PER-PAGE. PERFORM WRITE-JCL-LINE VARYING INDEX-1 FROM 1 BY 1 UNTIL INDEX-1 > 8. LOOP-01. * GET LINE/CHANNEL ACCEPT CARD-IN. IF CARD-IN = 'END' THEN GO TO EOJ-RTN. IF LINE-NO NOT NUMERIC THEN DISPLAY '* ERROR - LINE INVALID *' GO TO EOJ-RTN. MOVE LINE-NO TO FCB-LINE. IF FCB-LINE > +255 THEN DISPLAY '* ERROR - LINE > 255 *' GO TO EOJ-RTN. IF FCB-LINE > LINES-PER-PAGE THEN DISPLAY '* ERROR - FCB LINE # > LINES PER PAGE *' GO TO EOJ-RTN. IF CHANNEL NOT NUMERIC THEN DISPLAY '* ERROR - INVALID CHANNEL *' GO TO EOJ-RTN. MOVE CHANNEL TO CHANNEL-NO. IF CHANNEL-NO > +12 THEN DISPLAY '* ERROR - CHANNEL > 12 *' GO TO EOJ-RTN. ADD +1 TO CHANNEL-NO. * SPECIAL CODE FOR 8 LPI IF BYTE1 = '1' THEN IF FCB-LINE > 1 THEN ADD +1 TO CURRENT-LINE MOVE 1 TO DC-LEN PERFORM WRITE-ASSEM-LINE. * BUILD FILLER IF FCB-LINE > CURRENT-LINE THEN PERFORM FILLER-RTN THRU WRITE-ASSEM-LINE. * CREATE CHANNEL LINE PERFORM SETUP-XL1-RTN. GO TO LOOP-01. SETUP-XL1-RTN. IF FCB-LINE = LINES-PER-PAGE THEN MOVE '1' TO BYTE1. ADD +1 TO CURRENT-LINE. MOVE 1 TO DC-LEN. MOVE HEX-BYTE (CHANNEL-NO) TO BYTE2. PERFORM WRITE-ASSEM-LINE. FILLER-RTN. COMPUTE DC-LEN = FCB-LINE - CURRENT-LINE. MOVE '00' TO DC-HEX. MOVE FCB-LINE TO CURRENT-LINE. WRITE-ASSEM-LINE. MOVE DEFINE-CONSTANT TO PUNCH-REC. PERFORM WRITE-RTN. MOVE '0' TO BYTE1. WRITE-JCL-LINE. MOVE JCL-LINE (INDEX-1) TO PUNCH-REC. PERFORM WRITE-RTN. WRITE-RTN. WRITE PUNCH-REC. EOJ-RTN. MOVE +1 TO CHANNEL-NO. IF CURRENT-LINE < LINES-PER-PAGE THEN MOVE LINES-PER-PAGE TO FCB-LINE PERFORM FILLER-RTN THRU WRITE-ASSEM-LINE MOVE '1' TO BYTE1 PERFORM SETUP-XL1-RTN. MOVE 256 TO FCB-LINE. PERFORM FILLER-RTN THRU WRITE-ASSEM-LINE. PERFORM WRITE-JCL-LINE VARYING INDEX-1 FROM 9 BY 1 UNTIL INDEX-1 > 15. CLOSE PUNCH-OUT. STOP RUN. /* /* /& * $$ EOJ