Return to Mainframe Utilities Page
Module
/**********************************************************************
/* 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
Documentation
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.