|
Back To LeighWeb Mainframe Utilities Page
View the documentation associated with this module
/**********************************************************************
/* UTILITY: LAYOUT *
/* AUTHOR: DAVID LEIGH *
/* FUNCTION: COMPILE A COPYBOOK AND BRING BACK THE LENGTH AND POSITION*
/* INFORMATION INTO THE COPYBOOK FROM THE COMPILE LISTING. *
/* CHANGE : DAVID SLEEMAN. *
/* CHANGED CODE TO BE ABLE TO HANDLE THE OCCURS CLAUSE AND *
/* PUT (1) AFTER TABLES ON THE SORT PARAMETER OPTIONS. *
/**********************************************************************
ISREDIT MACRO (OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10)
ISPEXEC CONTROL ERRORS RETURN
/**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/
ISPEXEC VGET (DBGSWTCH) PROFILE
IF &DBGSWTCH = &STR(ON) THEN +
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH
ELSE +
CONTROL NOMSG NOLIST NOFLUSH NOPROMPT
/**********************************************************************
/* NOTIFY THE USER *
/**********************************************************************
SET ZEDLMSG = &STR(*** PREPARING TO CALL THE COBOL COMPILER ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
/**********************************************************************
/* SET PROCESSING VARIABLES *
/**********************************************************************
DO &I = 1 TO 10
IF &STR(&SYSNSUB(2,&&OPT&I)) > THEN +
DO
SET X = &STR(&SYSNSUB(2,&&OPT&I))
SELECT (&STR(&X))
WHEN (SYNCSORT ¦ SORT) SET FORMAT = SYNCSORT
WHEN (RDW) SET RDW = RDW
WHEN (X) DO
SET EXCLUDE = ON
SET OPTIONS = &STR(&OPTIONS &X)
END
OTHERWISE SET OPTIONS = &STR(&OPTIONS &X)
END
END
END
SET COMPILER = IGYCRCTL
/**********************************************************************
/* ALLOCATE THE NECESSARY DD'S FOR THE COMPILE *
/**********************************************************************
FREE DD(SYSIN SYSLIB SYSPRINT SYSLIN +
SYSUT1 SYSUT2 SYSUT3 SYSUT4 SYSUT5 SYSUT6 SYSUT7)
ALLOC DD(SYSLIB) DATASET('PPROD.STR.COPYLIB')
ALLOC DD(SYSLIN) DUMMY
ALLOC DD(SYSUT1) UNIT(SYSDA) SPACE(1,1) CYLINDERS
ALLOC DD(SYSUT2) UNIT(SYSDA) SPACE(1,1) CYLINDERS
ALLOC DD(SYSUT3) UNIT(SYSDA) SPACE(1,1) CYLINDERS
ALLOC DD(SYSUT4) UNIT(SYSDA) SPACE(1,1) CYLINDERS
ALLOC DD(SYSUT5) UNIT(SYSDA) SPACE(1,1) CYLINDERS
ALLOC DD(SYSUT6) UNIT(SYSDA) SPACE(1,1) CYLINDERS
ALLOC DD(SYSUT7) UNIT(SYSDA) SPACE(1,1) CYLINDERS
ALLOC DD(SYSPRINT) +
NEW +
UNIT(SYSDA) +
SPACE(1,1) TRACKS RELEASE +
RECFM(F B A) LRECL(133) BLKSIZE(23408) DSORG(PS)
ALLOC DD(SYSIN) +
NEW +
UNIT(SYSDA) +
SPACE(1,1) TRACKS RELEASE +
RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)
/**********************************************************************
/* UNIQUELY DEFINE "FILLER" *
/**********************************************************************
SET FILLNUM = 0
ISREDIT SEEK FIRST ' FILLER-1 ' &STR(&OPTIONS)
DO WHILE &LASTCC = 0
SET FILLNUM = &FILLNUM + 1
ISREDIT CHANGE 'FILLER' 'FILLER-&FILLNUM'
IF &LASTCC = 0 AND &EXCLUDE = ON THEN +
DO
ISREDIT EXCLUDE FIRST 'FILLER' .ZCSR .ZCSR
ISREDIT SEEK LAST P'=' .ZCSR .ZCSR
END
ISREDIT SEEK NEXT ' FILLER-2 ' &STR(&OPTIONS)
END
/**********************************************************************
/* MAKE A "PROGRAM" OUT OF THIS COPYBOOK *
/**********************************************************************
OPENFILE SYSIN OUTPUT
SET SYSIN = &STR( IDENTIFICATION DIVISION.)
PUTFILE SYSIN
SET SYSIN = &STR( PROGRAM-ID. TESTPGM.)
PUTFILE SYSIN
SET SYSIN = &STR( DATE-COMPILED.)
PUTFILE SYSIN
SET SYSIN = &STR( ENVIRONMENT DIVISION.)
PUTFILE SYSIN
SET SYSIN = &STR( INPUT-OUTPUT SECTION.)
PUTFILE SYSIN
SET SYSIN = &STR( FILE-CONTROL.)
PUTFILE SYSIN
SET SYSIN = &STR( DATA DIVISION.)
PUTFILE SYSIN
SET SYSIN = &STR( FILE SECTION.)
PUTFILE SYSIN
SET SYSIN = &STR( WORKING-STORAGE SECTION.)
PUTFILE SYSIN
ISREDIT (X,Y) = NUMBER
IF &X = ON AND &SYSINDEX(&STR( COBOL),&STR(&Y)) > 0 THEN +
DO
SET COL1 = 1
SET COL2 = 66
SET COL3 = 4
SET PREFIX = &STR( )
END
ELSE +
DO
SET COL1 = 7
SET COL2 = 72
SET COL3 = 10
SET PREFIX =
END
/**********************************************************************
/* LOOK FOR AN "01" LEVEL TO BEGIN THE DATA ELEMENT *
/**********************************************************************
ISREDIT CURSOR = 1 1
LOOP_01: +
ISREDIT SEEK NEXT P' #' &COL1 &COL2 &STR(&OPTIONS)
ISREDIT (LN1,CL1) = CURSOR
ISREDIT SEEK NEXT ' ' .ZCSR .ZCSR
ISREDIT (LN2,CL2) = CURSOR
ISREDIT SEEK FIRST P'¬' &COL1 &COL1 .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
ISREDIT SEEK LAST P'=' .ZCSR .ZCSR
GOTO LOOP_01
END
ISREDIT (NBR) = LINE .ZCSR
SET NBR = &SUBSTR(&CL1:&CL2,&STR(&NBR))
SET NBR = &NBR
IF &NBR > 1 THEN +
DO
SET SYSIN = &STR( 01 TEMP-LAYOUT-AREA.)
PUTFILE SYSIN
END
ISREDIT SEEK FIRST P'=' &COL3 &STR(&OPTIONS)
DO WHILE &LASTCC = 0
ISREDIT (SYSIN) = LINE .ZCSR
SET SYSIN = &STR(&PREFIX&SYSNSUB(1,&SYSIN))
PUTFILE SYSIN
ISREDIT SEEK NEXT P'=' &COL3 &STR(&OPTIONS)
END
SET SYSIN = &STR( PROCEDURE DIVISION.)
PUTFILE SYSIN
SET SYSIN = &STR( GOBACK.)
PUTFILE SYSIN
CLOSFILE SYSIN
/**********************************************************************
/* NOTIFY THE USER *
/**********************************************************************
SET ZEDLMSG = &STR(*** COMPILING THIS DATA ELEMENT DESCRIPTION ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
/**********************************************************************
/* COMPILE THE SUCKER ! *
/**********************************************************************
CALL 'SYS1.IGY.SIGYCOMP(&COMPILER)'
/* ISPEXEC SELECT PGM(&COMPILER) */
SET SAVECC = &LASTCC
IF &SAVECC > 4 THEN +
DO
SET ZEDLMSG = &STR(*** COMPILE UNSUCCESSFUL! RC=&SAVECC ***)
ISPEXEC SETMSG MSG(UTLZ001W)
ISPEXEC LMINIT DATAID(DID) DDNAME(SYSPRINT)
ISPEXEC EDIT DATAID(&DID)
ISPEXEC LMFREE DATAID(&DID)
GOTO FINISH
END
/**********************************************************************
/* NOTIFY THE USER *
/**********************************************************************
SET ZEDLMSG = &STR(*** EXTRACTING THE COMPILER LISTING OUTPUT ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
/**********************************************************************
/* EXTRACT THE DATA *
/**********************************************************************
FREE DD(SYSIN SYSLIB SYSLIN +
SYSUT1 SYSUT2 SYSUT3 SYSUT4 SYSUT5 SYSUT6 SYSUT7)
ISPEXEC LMINIT DATAID(DID) DDNAME(SYSPRINT)
ISPEXEC EDIT DATAID(&DID) MACRO(LAYOUTMA)
/**********************************************************************
/* NOTIFY THE USER *
/**********************************************************************
IF &FORMAT = SYNCSORT THEN +
SET ZEDLMSG = &STR(*** CONVERTING TO SYNCSORT FORMAT ***)
ELSE +
SET ZEDLMSG = &STR(*** INSERTING MESSAGE LINES ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
/**********************************************************************
/* INSERT THE INFORMATION AS MESSAGE LINES *
/**********************************************************************
ISPEXEC LMFREE DATAID(&DID)
FREE DD(SYSPRINT)
ISPEXEC VGET (CPINNUM CPIVAR CPIMAX) SHARED
SET CPIMAX = &LENGTH(&CPIMAX)
DO &I = 1 TO &CPIMAX
SET ZEROPFX = &STR(0&ZEROPFX)
SET QUESPFX = &STR(?&QUESPFX)
END
SET CPIMAX = &CPIMAX - 1
IF &CPIVAR = YES THEN +
DO
SET RDW = RDW
IF &FORMAT = SYNCSORT THEN +
SET RDWLINE = &SUBSTR(&LENGTH(&STR(&ZEROPFX.1))-&CPIMAX:+
&LENGTH(&STR(&ZEROPFX.1)),+
&STR(&ZEROPFX.1))+
&STR(,)+
&SUBSTR(&LENGTH(&STR(&ZEROPFX.4))-&CPIMAX:+
&LENGTH(&STR(&ZEROPFX.4)),+
&STR(&ZEROPFX.4))+
&STR(,CH,A,)
END
SET &OCCURSW = NO
DO &I = 1 TO &CPINNUM
SET ZEDSMSG = &STR(ON &I OF &CPINNUM)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000)
ISPEXEC VGET (CPID&I +
CPIH&I +
CPIP&I +
CPIL&I +
CPIF&I +
CPIO&I +
CPIR&I +
CPIV&I) SHARED
IF &STR(&SYSNSUB(2,&&CPIO&I)) = YES THEN +
SET &HEX = YES
IF &HEX = YES THEN +
DO
ISPEXEC SELECT PGM(HEX2DECP) PARM(&STR(&SYSNSUB(2,&&CPIH&I)))
ISPEXEC VGET DECNUM SHARED
SET DECNUM = &DECNUM + 1
SET POSITION = &DECNUM
END
ELSE +
SET POSITION = &STR(&SYSNSUB(2,&&CPIP&I))
ISREDIT FIND FIRST ' &STR(&SYSNSUB(2,&&CPID&I)) ' &STR(&OPTIONS)
IF &LASTCC ¬= 0 THEN +
ISREDIT FIND FIRST ' &STR(&SYSNSUB(2,&&CPID&I)). ' &STR(&OPTIONS)
IF &FORMAT = SYNCSORT THEN +
DO
SET &OCCUR =
SET LEVEL = &STR(&SYSNSUB(2,&&CPIV&I))
SET LEVEL = &LEVEL - 13 + 35
IF &HLDLEVEL = &LEVEL OR &HLDLEVEL > &LEVEL THEN +
SET OCCURSW = NO
IF &OCCURSW = YES THEN SET OCCUR = &STR((1))
IF &POSITION = 1 AND &RDW = RDW THEN +
DO
SET CPIVAR = YES
SET RDW =
ISREDIT LINE_BEFORE .ZCSR = <15,(RDWLINE) +
32,' * RDW'>
END
IF &CPIVAR = YES THEN SET POSITION = &POSITION + 4
SET POSITION = &STR(&ZEROPFX&POSITION)
SET L = &LENGTH(&STR(&POSITION))
IF &POSITIONS = OFF THEN SET POSITION = &STR(&QUESPFX)
ELSE SET POSITION = &SUBSTR(&L-&CPIMAX:&L,&STR(&POSITION))
SET DATALEN = &STR(&ZEROPFX&SYSNSUB(2,&&CPIL&I))
SET L = &LENGTH(&STR(&DATALEN))
SET DATALEN = &SUBSTR(&L-&CPIMAX:&L,&STR(&DATALEN))
IF &STR(&SYSNSUB(2,&&CPIO&I)) = YES AND +
&OCCURSW = NO THEN +
DO
SET OCCURSW = YES
SET HLDLEVEL = &LEVEL
END
SET DATANAME = &STR(&SYSNSUB(2,&&CPID&I) &OCCUR)
SET SORTFMT = &STR(&SYSNSUB(2,&&CPIF&I))
SET STRING = &STR(&POSITION,&DATALEN,&SORTFMT,A, * )
ISREDIT LINE .ZCSR = <15,(STRING) +
(LEVEL),(DATANAME) +
72,' '>
END
ELSE +
DO
IF &POSITIONS = OFF THEN SET CPIP&I = &STR(?????)
SET MESSAGE = &STR(POSITION=&POSITION )+
&STR(LENGTH=&SYSNSUB(2,&&CPIL&I ))
/* &STR(HEX=&DECNUM)
ISREDIT (LN,CL) = CURSOR
IF &SLN = THEN SET SLN = &LN
SET CL = &CL + 1
ISREDIT LINE_BEFORE .ZCSR = MSGLINE <(CL) (MESSAGE)>
END
/* SET MESSAGE = &STR(POSITION=&SYSNSUB(2,&&CPIP&I) )+
/* DO
/* SET POSITIONS = OFF
/* ISREDIT LINE_BEFORE .ZCSR = MSGLINE +
/* '&STR(*** DEFINED WITH "OCCURS" *** +
/* SUBSEQUENT "POSITIONS" ARE UNKNOWN ***)'
/* END
END
/**********************************************************************
/* CLEAN UP *
/**********************************************************************
IF &FORMAT = SYNCSORT THEN +
DO
ISREDIT EXCLUDE ALL .ZFIRST .ZLAST
IF &POSITIONS = OFF THEN ISREDIT LOCATE FIRST SPECIAL
SET STGPOS = &EVAL(((&CPIMAX+1)*2)+19)
ISREDIT FIND ALL ',A, * ' &STGPOS
ISREDIT LINE_BEFORE .ZFIRST = ' SORT FIELDS=('
ISREDIT DELETE EXCLUDED .ZFIRST .ZLAST
END
ELSE +
ISREDIT RESET EXCLUDED
/**********************************************************************
/* CLEAN UP FILLERS *
/**********************************************************************
FINISH: +
DO &I = 1 TO &FILLNUM
ISREDIT CHANGE FIRST 'FILLER-&I ' 'FILLER '
END
IF &FORMAT = SYNCSORT THEN +
ISREDIT CURSOR = 1 1
ELSE +
DO
ISREDIT CURSOR = &SLN 1
ISREDIT FIND PREV P'=' 1
END
EXIT
|
|
