/**********************************************************************
/* CLIST: COMPILE                                                     *
/* AUTHOR: DAVID LEIGH                                                *
/* FUNCTION: THIS CLIST CONTROLS A CLIST/ISPF DIALOG TO FACILITATE    *
/*           COMPILING OF COBOL, COBOL2, AND ASSEMBLER PROGRAMS AND   *
/*           MAPS IN BATCH AND CICS ENVIRONMENTS.                     *
/**********************************************************************
PROC 0 JCLREVEW(N)       /* INITIALIZE THE JCL REVIEW VALUE TO "NO" */ +
       ISPF                 /* SEND RESULTS TO AN ISPLLIB LOAD LIB  */ +
       HELP                   /* DISPLAY HELP INSTEAD OF PROCESSING */ +
       DEBUG            /* SHOW DEBUGGING MESSAGES DURING EXECUTION */
CONTROL NOMSG NOLIST NOFLUSH NOPROMPT
/**********************************************************************
/* CONTROL CLIST/EDIT MODE PROCESSING                                 *
/**********************************************************************
ERROR DO
          SET MODE = CLIST
          RETURN
      END
ISREDIT MACRO (OPT1 OPT2 OPT3)
ERROR OFF

/**********************************************************************
/* LOG THE USE                                                        *
/**********************************************************************

/**********************************************************************
/* IF AN EDIT MACRO, PROCESS THE OPTIONS                              *
/**********************************************************************
IF &STR(&MODE) ¬= CLIST THEN +
    DO
        SET ZEDLMSG = &STR(*** PARSING THIS SOURCE TO SET COMPILE +
                           DEFAULTS ***)
        ISPEXEC CONTROL DISPLAY LOCK
        ISPEXEC DISPLAY MSG(UTLZ000W)
        SELECT (&OPT1)
            WHEN (ISPF)  SET ISPF  = ISPF
            WHEN (HELP)  SET HELP  = HELP
            WHEN (DEBUG) SET DEBUG = DEBUG
        END
        SELECT (&OPT2)
            WHEN (ISPF)  SET ISPF  = ISPF
            WHEN (HELP)  SET HELP  = HELP
            WHEN (DEBUG) SET DEBUG = DEBUG
        END
        SELECT (&OPT3)
            WHEN (ISPF)  SET ISPF  = ISPF
            WHEN (HELP)  SET HELP  = HELP
            WHEN (DEBUG) SET DEBUG = DEBUG
        END
    END

/**********************************************************************
/* CONTROL DEBUG PROCESSING                                           *
/**********************************************************************
ISPEXEC CONTROL ERRORS RETURN
IF &DEBUG = DEBUG THEN +
    CONTROL MSG LIST CONLIST SYMLIST NOFLUSH
ELSE +
    CONTROL NOMSG NOLIST NOFLUSH NOPROMPT

/**********************************************************************
/* CONTROL HELP PROCESSING                                            *
/**********************************************************************
IF &HELP = HELP THEN GOTO HELPSEC

/**********************************************************************
/* ESTABLISH SOME VARIABLES AND GET SOME PROFILE VARIABLE VALUES      *
/**********************************************************************
CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID '
SET LP = &STR((
SET RP = &STR())
SET AMPER = &STR(&&)
SET LANG =
SET CMPCICS =
ISPEXEC VGET (CMPPCONF CMPTYPE CMPTYPFX CMPAPPL CMPJSUFF +
              CMPALIST CMPPTRN CMPDTRN CMPPLKED CMPDLKED CMPJCLR +
              CMPCLASS CMPPR CMPLDASD) PROFILE
IF &STR(&CMPTYPE) =     THEN SET CMPTYPE = &STR(COB2)
IF &STR(&CMPTYPFX) =    THEN SET CMPTYPFX = &STR(T)
IF &STR(&CMPAPPL) =     THEN +
    IF &SUBSTR(2:2,&STR(&SYSUID)) = &STR(#) THEN +
        SET CMPAPPL = GSS
    ELSE +
        SET CMPAPPL = SLSS
IF &STR(&CMPJSUFF) =      THEN SET CMPJSUFF = &STR(CMP)
IF &STR(&CMPCLASS) =      THEN SET CMPCLASS = &STR(1)
IF &STR(&CMPPR) =         THEN SET CMPPR = &STR(Z00000)
IF &STR(&CMPPTRN) =       THEN SET CMPPTRN = &STR(N)
IF &STR(&CMPPLKED) =      THEN SET CMPPLKED = &STR(N)
IF &STR(&CMPDTRN) =       THEN SET CMPDTRN = &STR(N)
IF &STR(&CMPDLKED) =      THEN SET CMPDLKED = &STR(N)
IF &STR(&CMPALIST) =      THEN SET CMPALIST = &STR(Y)
IF &STR(&CMPJCLR) =       THEN SET CMPJCLR  = &STR(N)
IF &STR(&CMPLDASD) =      THEN SET CMPLDASD = &STR(T)
ISPEXEC VPUT (CMPPCONF CMPTYPE CMPTYPFX CMPAPPL CMPJSUFF +
              CMPALIST CMPPTRN CMPDTRN CMPPLKED CMPDLKED CMPJCLR +
              CMPCLASS CMPPR CMPLDASD) PROFILE
SET JCLREVEW = &STR(&CMPJCLR)

/***********************************************************************
/* PARSE FOR DATASET INFORMATION AND LANGUAGE TYPE IF THIS IS A MACRO  *
/***********************************************************************
IF &MODE ¬= CLIST THEN +
    DO
        ISREDIT (PACK) = PACK
        IF &PACK = ON THEN +
            DO
                SET ZEDSMSG = &STR(DATA IS PACKED)
                SET ZEDLMSG = &STR(UNPACK THE DATA AND SAVE +
                                   THE DATASET FIRST)
                ISPEXEC SETMSG MSG(UTLZ001)
                GOTO FINISH
            END
        ISREDIT (LN,CL) = CURSOR
        ISREDIT (CMPDSN) = DATASET
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1 7
                ISREDIT FIND FIRST ' IDENTIFICATION DIVISION. ' NX
                IF &LASTCC = 0 THEN SET LANG = COB2
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1 7
                ISREDIT FIND FIRST ' ENVIRONMENT DIVISION. ' NX
                IF &LASTCC = 0 THEN SET LANG = COB2
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1 7
                ISREDIT FIND FIRST ' DATA DIVISION ' NX
                IF &LASTCC = 0 THEN SET LANG = COB2
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1 7
                ISREDIT FIND FIRST ' WORKING-STORAGE SECTION. ' NX
                IF &LASTCC = 0 THEN SET LANG = COB2
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1 7
                ISREDIT FIND FIRST ' PROCEDURE DIVISION. ' NX
                IF &LASTCC = 0 THEN SET LANG = COB2
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1
                ISREDIT FIND FIRST ' DFHMDI ' 8 NX
                IF &LASTCC = 0 THEN SET LANG = MAP
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1
                ISREDIT FIND FIRST ' DFHMSD ' 8 NX
                IF &LASTCC = 0 THEN SET LANG = MAP
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1
                ISREDIT FIND FIRST ' DFHMDF ' 8 NX
                IF &LASTCC = 0 THEN SET LANG = MAP
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1
                ISREDIT FIND FIRST ' CSECT ' 3 15 NX
                IF &LASTCC = 0 THEN SET LANG = ASM
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1
                ISREDIT FIND FIRST ' DSECT ' 3 15 NX

                IF &LASTCC = 0 THEN SET LANG = ASM
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1
                ISREDIT FIND FIRST ' MACRO ' 3 15 NX
                IF &LASTCC = 0 THEN SET LANG = ASM
            END
        IF &STR(&LANG) =     THEN +
            DO
                ISREDIT EXCLUDE ALL '*' 1
                ISREDIT FIND FIRST ' TITLE ' 3 15 NX
                IF &LASTCC = 0 THEN SET LANG = ASM
            END
        IF &STR(&CMPCICS) =     THEN +
            DO
                ISREDIT FIND FIRST ' EXEC CICS ' NX
                IF &LASTCC = 0 THEN SET CMPCICS = Y
            END
        IF &STR(&CMPCICS) =     THEN +
            DO
                ISREDIT FIND FIRST ' EXEC  CICS ' NX
                IF &LASTCC = 0 THEN SET CMPCICS = Y
            END
        ISREDIT RESET EXCLUDED
        IF &STR(&LANG) >     THEN +
            IF &STR(&CMPCICS) = &STR(Y) THEN +
                SET CMPTYPE = &STR(C&LANG)
            ELSE +
                SET CMPTYPE = &STR(&LANG)
        ELSE +
            SET CMPTYPE =
        ISREDIT (MEMBER) = MEMBER
        IF &STR(&MEMBER) >   THEN +
            DO
                SET MEMBER8 = &SUBSTR(1:8,&STR(&MEMBER        ))
                SET CMPDSN = &STR(&CMPDSN(&MEMBER))
                IF &STR(&CMPALIST) = &STR(N) THEN +
                    SET CMPLDSN =
                ELSE +
                    SET CMPLDSN = &STR(&SYSUID..COMPILE.)+
                                  &STR(LISTING.&MEMBER)
            END
        ELSE +
            DO
                SET MEMBER8 = &STR(SEQ. DSN)
                SET DATE = &STR(D)+
                           &SUBSTR(1:2,&STR(&SYSSDATE))+
                           &SUBSTR(4:5,&STR(&SYSSDATE))+
                           &SUBSTR(7:8,&STR(&SYSSDATE))
                SET TIME = &STR(T)+
                           &SUBSTR(1:2,&STR(&SYSTIME))+
                           &SUBSTR(4:5,&STR(&SYSTIME))+
                           &SUBSTR(7:8,&STR(&SYSTIME))
                IF &STR(&CMPALIST) = &STR(N) THEN +
                    SET CMPLDSN =
                ELSE +
                    SET CMPLDSN = &STR(&SYSUID..COMPILE.)+
                                  &STR(LISTING.&DATE..&TIME)
            END
        IF &ISPF = ISPF THEN +
            SET CMPALOAD = &STR(&SYSUID..&CMPAPPL..ISPLLIB)
        ISREDIT CURSOR = &LN &CL
    END

/**********************************************************************
/* FIND OUT THE CURRENT VALID PRINT CONFIGURATIONS                    *
/**********************************************************************
SET ALLCONF = &STR( )
ISPEXEC TBOPEN PRINTIT NOWRITE
IF &LASTCC = 0 THEN +
    DO
        ISPEXEC TBSKIP PRINTIT
        DO WHILE &LASTCC = 0
            SET ALLCONF = &STR(&ALLCONF&PTCONNAM )
            ISPEXEC TBSKIP PRINTIT
        END
        ISPEXEC TBEND PRINTIT
    END

/***********************************************************************
/* DISPLAY THE PROCESSING PANEL                                        *
/***********************************************************************
REDISPLAY: +
ISPEXEC DISPLAY PANEL(COMPILE)
IF &LASTCC > 7 THEN +
    DO
FINISH: EXIT
    END

/**********************************************************************
/* PROCESS THE USER'S PRIMARY COMMANDS IF ANY                         *
/**********************************************************************
IF &STR(&ZCMD) =      THEN GOTO BUILD
SET SYSDVAL = &STR(&ZCMD)
READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10

SELECT (&SYSCAPS(&STR(&ZCMD)))
    WHEN (OPT ¦ OPTION ¦ OPTIONS) DO
        ISPEXEC DISPLAY PANEL(COMPILE3)
        SET ZEDLMSG = &STR(*** COMPILE UTILITY OPTIONS UPDATED ***)
        ISPEXEC SETMSG MSG(UTLZ000)
    END
    WHEN (SHOW) DO
        IF &STR(&SYSCAPS(&OPT1)) = &STR(ERRORS) THEN +
            DO
                ISPEXEC CONTROL ERRORS CANCEL
                GOTO BUILD
            END
        ELSE GOTO OTHER
    END


    OTHERWISE DO
OTHER:  SET ZEDSMSG = &STR(INVALID COMMAND)
        SET ZEDLMSG = &STR(VALID COMMANDS: +
                          "OPTIONS")
        ISPEXEC SETMSG MSG(UTLZ001W)
    END
END

GOTO REDISPLAY

/**********************************************************************
/* FURTHER INPUT EDITS                                                *
/**********************************************************************
BUILD: +
LISTDSI '&CMPDSN'
IF &SYSDSORG ¬= &STR(PO) THEN +
    IF &STR(&CMPALOAD) =     THEN +
        DO
            SET ZEDLMSG = &STR(ALTERNATE LOAD LIB MUST BE ENTERED IF +
                               SOURCE IS NOT A PDS MEMBER)
            ISPEXEC SETMSG MSG(UTLZ001W)
            GOTO REDISPLAY
        END
    ELSE
ELSE +
    DO
        SET X = &SYSINDEX(&STR(&LP),&STR(&CMPDSN))
        SET Y = &SYSINDEX(&STR(&RP),&STR(&CMPDSN))
        SET X = &X + 1
        SET Y = &Y - 1
        IF &Y < &X OR &X = 1 OR &Y = 0 THEN +
            DO
                SET ZEDLMSG = &STR(A MEMBER NAME MUST BE PART OF THE +
                                   SOURCE DSN IF IT IS A PDS)
                ISPEXEC SETMSG MSG(UTLZ001W)
                GOTO REDISPLAY
            END
        ELSE +
            DO
                SET MEMBER = &SUBSTR(&X:&Y,&STR(&CMPDSN))
                SET MEMBER8 = &SUBSTR(1:8,&STR(&MEMBER        ))
            END
    END

/**********************************************************************
/* DETERMINE LANGUAGE IF NOT FOUND BY NOW                             *
/**********************************************************************
IF &LANG =     OR +
   &SYSINDEX(&STR(&LANG),&STR(&CMPTYPE)) = 0 THEN +
    DO
        IF &SYSINDEX(&STR(COB2),&STR(&CMPTYPE)) > 0 THEN +
            DO
                SET LANG = COB2
                IF &STR(&LANG) ¬= &STR(&CMPTYPE) AND +
                   &SUBSTR(1:1,&STR(&CMPTYPE)) = C THEN +
                    SET CMPCICS = Y
                ELSE +
                    SET CMPCICS =
            END
        ELSE +
        IF &SYSINDEX(&STR(ASM),&STR(&CMPTYPE)) > 0 THEN +
            DO
                SET LANG = ASM
                IF &STR(&LANG) ¬= &STR(&CMPTYPE) AND +
                   &SUBSTR(1:1,&STR(&CMPTYPE)) = C THEN +
                    SET CMPCICS = Y
                ELSE +
                    SET CMPCICS =
            END
        ELSE SET LANG = MAP
    END

/**********************************************************************
/* DEAL WITH PRINT CONFIGURATIONS                                     *
/**********************************************************************
IF &STR(&CMPPCONF) >     AND +
   &SYSINDEX(&STR( &CMPPCONF ),&STR(&ALLCONF)) = 0 THEN +
    DO
        IF &STR(&CMPPCONF) ¬= &STR(?) THEN +
            DO
                SET ZEDLMSG = &STR(*** "&CMPPCONF" IS NOT A VALID +
                                   PRINT CONFIGURATION ***)
                ISPEXEC SETMSG MSG(UTLZ001)
            END
        SET CMPPCONF =
        ISPEXEC TBOPEN PRINTIT NOWRITE
        ISPEXEC TBDISPL PRINTIT PANEL(COMPILE2)
        IF &LASTCC < 8 THEN +
            IF &ZTDSELS ¬= &STR(0000) THEN +
                SET CMPPCONF = &STR(&PTCONNAM)
        SET CMPSEL =
        ISPEXEC TBEND PRINTIT
        GOTO REDISPLAY
    END

/**********************************************************************
/* BUILD THE JCL                                                      *
/**********************************************************************
SELECT (&STR(&CMPLDASD))
    WHEN (T) SET VOLUME = &STR(VOL=SER=WRK$$$,)
    WHEN (P) SET VOLUME =
END
IF &JCLREVEW = &STR(Y) THEN +
    DO
        SET TEMPJCL = &STR(&SYSUID..TEMP.COMPILE.JCL)
        DELETE '&TEMPJCL'
        FREE DDNAME(ISPFILE)
        ALLOCATE DDNAME(ISPFILE) DSN('&TEMPJCL') +
                 NEW CATALOG +
                 UNIT(SYSDA) VOLUME(WRK$$$) +
                 SPACE(1,1) TRACKS RELEASE +
                 RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)
        ISPEXEC FTOPEN
        ISPEXEC FTINCL COMPILE
        SET SAVECC = &LASTCC
        ISPEXEC FTCLOSE
        FREE DDNAME(ISPFILE)
        IF &SAVECC > 0 THEN +
            DO
                SET ZEDSMSG = &STR(JCL CREATION ERROR)
                SET ZEDLMSG = &STR(FILE TAILORING OF SKELETON MEMBER +
                                   "COMPILE" FAILED WITH AN RC OF +
                                   "&SAVECC")
                ISPEXEC SETMSG MSG(UTLZ001)
            END
        ELSE +
            DO
                SET ZEDSMSG =
                SET ZEDLMSG = &STR(*** NOTE:  YOU MUST SUBMIT THIS +
                                   JCL YOURSELF ***)
                ISPEXEC SETMSG MSG(UTLZ000W)
                ISPEXEC EDIT DATASET('&TEMPJCL')
            END
    END
ELSE +
    DO
        ISPEXEC FTOPEN TEMP
        ISPEXEC FTINCL COMPILE
        SET SAVECC = &LASTCC
        ISPEXEC FTCLOSE
        IF &SAVECC > 0 THEN +
            DO
                SET ZEDSMSG = &STR(JCL CREATION ERROR)
                SET ZEDLMSG = &STR(FILE TAILORING OF SKELETON MEMBER +
                                   "COMPILE" FAILED WITH AN RC OF +
                                   "&SAVECC")
                ISPEXEC SETMSG MSG(UTLZ001)
            END
        ELSE +
            DO
                ISPEXEC VGET ZTEMPF
                SUBMIT '&ZTEMPF'
                SET ZEDSMSG = &STR(JOB SUBMITTED)
                SET ZEDLMSG = &STR(*** THE CREATED JCL WAS SUBMITTED +
                                   ***)
                ISPEXEC SETMSG MSG(UTLZ000)
            END
    END

ISPEXEC VGET TYPEHOLD SHARED
IF &STR(&TYPEHOLD) >    THEN +
    DO
        SET CMPTYPFX = &STR(&TYPEHOLD)
        ISPEXEC VPUT CMPTYPFX PROFILE
    END

IF &STR(&ZCMD) = &STR(SHOW ERRORS) THEN +
        ISPEXEC CONTROL ERRORS RETURN

IF &STR(&MODE) = CLIST THEN +
    DO
        SET CMPCICS =
        SET LANG =
    END

IF &STR(&JCLREVEW) = Y THEN +
    GOTO REDISPLAY
ELSE +
    GOTO FINISH

/**********************************************************************
/* DISPLAY THE HELP TUTORIAL                                          *
/**********************************************************************
HELPSEC: +
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL)
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COMPILE UTILITY +
                   *** NO PROCESSING PERFORMED ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT
            

 COMPILE is an ISPF dialog which creates appropriate compile or assemble JCL for
 source code of varying types and automatically submits it.  COMPILE may be
 invoked as a CLIST or as an edit macro.  The JCL is created automatically and
 can be edited or submitted automatically as well.

 A complete ISPF help/tutorial exists for COMPILE.  More information can be
 found there.