|
Back To LeighWeb Mainframe Utilities Page
View the documentation associated with this 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
|
|
