/* */
trace off
parse upper arg Source Coverage .
Lib = 'USR1.NEWPROD'
Machine = 'Y2KUNIT'
Fm = 'A' /* Assume A disk */
IF userid() = 'UMFRUN' then Fm = 'E'
IF Coverage ^= 'NO' then Coverage = 'YES'
IF Source = '' then signal GetInfo
Phase = Source
signal Begin
GetInfo:
say 'Enter Source'
pull Source
IF Source = '' then exit 69
say 'Enter Phase/Object name. Default is' Source
pull Phase
IF Phase = '' then Phase = Source
say 'Add coverage code? YES/NO default is YES'
pull Coverage
IF Coverage = '' then Coverage = 'YES'
Begin:
'SET IMSG OFF'
'SET EMSG OFF'
'ERASE GENCOV $TEMP2$ A'
'SET IMSG ON'
'SET EMSG ON'
'STATE' Source 'OUTCOB F'
IF rc ^= 0 then do
say Source 'OUTCOB F not found'
exit 69
end
'ERASE' Source 'COVCOB' Fm
In_EXEC = 'NO' /* Not in EXEC-CICS */
PEnv = 'BATCH'
Ptype = 'MAIN'
DLI = 'NO'
StartWord = 'PROCEDURE'
'pipe < ' Source ' OUTCOB F | locate /DLITCBL/ | VAR dli_found'
IF pos('DLITCBL',dli_found) > 0 then do
DLI = 'YES'
StartWord = 'ENTRY'
end
Space40 = ' '
IF Source = 'BCGCCR87' | Source = 'ABEND' then PType = 'SUB'
Sub = -1
/*
say 'Source ' Source ' type ' Ptype ' phase ' Phase ' coverage code ' Coverage
*/
/* Get program source into variables */
'EXECIO * DISKR ' Source ' OUTCOB F (STEM ILINE.'
/* Process source */
DO i = 1 to iline.0
IF substr(iline.i,7,1) ^= ' ' then do
call CopyLine
end
ELSE do
FirstWord = word(substr(iline.i,8),1)
Col80 = substr(iline.i,80,1)
call TestLine
end
end
/* Add Coverage initialise and report code */
IF Coverage = 'YES' then do
aline = ' ITD--INIT-COVERAGE SECTION.'
call AddLine
aline = ' MOVE LOW-VALUES TO ITD--COVERAGE-TABLE.'
call AddLine
aline = ' MOVE SPACES TO ITD--COVERAGE-TEXT.'
call AddLine
aline = " MOVE " "'"||Source||"'" " TO ITD--PROGRAM."
call Addline
aline = ' MOVE ' Sub ' TO ITD--LAST-VERB.'
call AddLine
'EXECIO 0 DISKW ' Source ' COVCOB' Fm '(FINIS'
'COPY GENCOV $TEMP2$ A' Source ' COVCOB' Fm '(APP'
aline = ' ITD--INIT-COVERAGE-EXIT. EXIT.'
call AddLine
'EXECIO 0 DISKW ' Source ' COVCOB' Fm '(FINIS'
'COPY GENCPD DATA J' Source ' COVCOB' Fm '(APP'
IF Penv = 'BATCH' then 'COPY GENCPDB DATA J' Source 'COVCOB' Fm '(APP'
IF Penv = 'CICS' then 'COPY GENCPDC DATA J' Source 'COVCOB' Fm '(APP'
end
/* Submit compilation */
'CP SP PU' Machine 'CONT'
call StartJCL
'PUNCH GENCOV $TEMP$ A (NOH'
'PUNCH' Source 'COVCOB' Fm '(NOH'
call EndJCL
'PUNCH GENCOV $TEMP$ A (NOH'
'CP SP PU CLOSE'
'CP SP PU NOCONT'
'CP SP PU OFF'
'ERASE GENCOV $TEMP$ A'
'ERASE GENCOV $TEMP2$ A'
exit
StartJCL:
'ERASE GENCOV $TEMP$ A'
IF PType = 'MAIN' & PEnv = 'BATCH' then do
queue "* $$ JOB JNM="Source",CLASS=0,DISP=D,FROM="userid()
queue "* $$ LST RBS=0,JSEP=0,CLASS=A,DEST=(,"userid()")"
queue "// JOB" Source "- COMPILE COBOL TO PHASE"
queue "// OPTION SYM,NODECK,NOLOG,CATAL"
queue " PHASE" Phase",*"
/* call Chk24 */
queue "// LIBDEF *,SEARCH=("Lib",PRD2.SCEEBASE,PRD2.RWPREC,PRD2.RWRUN)"
queue "// LIBDEF PHASE,CATALOG="Lib
queue "// EXEC IGYCRCTL,SIZE=512K, *"
queue " PARM='EXIT(INEXIT(RW),PRTEXIT(RW)'"
queue " CBL SEQ,FLAG(W,E),MAP,APOST,TRUNC(STD),ZWB,NOOPT,LIB,OFFSET"
queue " CBL TEST(SYM)"
end
IF PType = 'SUB' then do
queue "* $$ JOB JNM="Source",CLASS=0,DISP=D,FROM="userid()
queue "* $$ LST CLASS=A,DEST=(,"userid()"),JSEP=0,RBS=0"
queue "* $$ PUN DISP=I,CLASS=U,PRI=3"
queue "// JOB "Source" - COMPILE COBOL TO OBJECT"
queue "// OPTION DECK,NOLIST,NOLOG"
queue "// EXEC ASMA90"
queue " PUNCH '* $$ LST JSEP=0,RBS=0,CLASS=A,DEST=(,"userid()")'"
queue " PUNCH '// JOB" Source "- CATALOG TO OBJECT'"
queue " PUNCH '// EXEC LIBR,SIZE=512K'"
queue " PUNCH ' ACCESS S="Lib"'"
queue " PUNCH ' CATALOG "Source".OBJ REPLACE=YES'"
queue " END"
queue "/*"
queue "// OPTION SYM,DECK,NOLOG,LIST"
queue "// LIBDEF *,SEARCH=("Lib",PRD2.SCEECICS,PRD2.SCEEBASE)"
queue "// EXEC IGYCRCTL,SIZE=IGYCRCTL"
queue " CBL SEQ,FLAG(W,E),MAP,APOST,TRUNC(STD),ZWB,NOOPT,LIB,OFFSET"
queue " CBL TEST(SYM)"
end
IF PEnv = 'CICS' then do
queue "* $$ JOB JNM="Source",CLASS=0,DISP=D,FROM="userid()
queue "* $$ LST CLASS=A,DEST=(,"userid()"),JSEP=0,RBS=0"
queue "* $$ PUN DISP=I,CLASS=U,PRI=3"
queue "// JOB "Source "- TRANSLATE COBOL CICS SOURCE"
queue "// OPTION DECK,NOLIST,NOLOG"
queue "// EXEC ASMA90"
queue " PUNCH '* $$ LST JSEP=0,RBS=0,CLASS=A,DEST=(,"userid()")'"
queue " PUNCH '// JOB "Source" - COMPILE TRANSLATED COBOL CICS SOURCE'"
queue " PUNCH '// OPTION SYM,NODECK,NOLOG,CATAL'"
queue " PUNCH '// LIBDEF *,SEARCH=("Lib",PRD2.SCEECICS,PRD2.SCEEBASE)'"
queue " PUNCH '// LIBDEF PHASE,CATALOG="Lib"'"
queue " PUNCH ' PHASE" Phase",*'"
queue " PUNCH ' INCLUDE DFHELII'"
queue " PUNCH '// EXEC IGYCRCTL,SIZE=IGYCRCTL'"
queue " PUNCH ' CBL SEQ,FLAG(W,E),MAP,APOST,TRUNC(STD),ZWB,NOOPT,LIB,OFFSET'"
queue " PUNCH ' CBL RENT,RMODE(ANY)'"
queue " END"
queue "/*"
queue "// EXEC DFHECP1$"
queue " CBL XOPTS(CICS NOSOURCE NONUM NOSEQ OPTIONS APOST ANSI85)"
end
'EXECIO' queued() 'DISKW GENCOV $TEMP$ A (FINIS'
return
EndJCL:
'ERASE GENCOV $TEMP$ A'
IF PType = 'MAIN' & PEnv = 'BATCH' then do
queue "/*"
queue "// LIBDEF *,SEARCH=("Lib",PRD2.SCEEBASE,PRD2.RWPREC,PRD2.RWRUN)"
IF DLI = 'YES' then queue " ENTRY DLITCBL"
queue "// EXEC LNKEDT,SIZE=512K"
queue "/*"
queue "/&"
queue "* $$ EOJ"
end
IF PType = 'SUB' then do
queue "/*"
queue "// OPTION DECK,NOLIST,NOLOG"
queue "// EXEC ASMA90"
queue " PUNCH '/+'"
queue " PUNCH '/*'"
queue " PUNCH '/&&'"
queue " PUNCH '* $$ EOJ'"
queue " END"
queue "/*"
queue "/&"
queue "* $$ EOJ"
end
IF PEnv = 'CICS' then do
queue "/*"
queue "// EXEC ASMA90"
queue " PUNCH '/*'"
queue " PUNCH '// LIBDEF *,SEARCH=("Lib",PRD2.SCEECICS,PRD2.SCEEBASE)'"
queue " PUNCH '// EXEC LNKEDT,SIZE=512K'"
queue " PUNCH '/*'"
queue " PUNCH '/&&'"
queue " PUNCH '* $$ EOJ'"
queue " END"
queue "/*"
queue "// IF $MRC >= 5 THEN"
queue "// GOTO ABEND"
queue "// GOTO END"
queue "/. ABEND"
queue "* *****************************"
queue "* TRANSLATOR FAILED WITH ERRORS"
queue "* *****************************"
queue "/. END"
queue "/*"
queue "/&"
queue "* $$ EOJ"
end
'EXECIO' queued() 'DISKW GENCOV $TEMP$ A (FINIS'
return
TestLine:
IF FirstWord = 'WORKING-STORAGE' then do
call CopyLine
IF Coverage = 'YES' then do
'EXECIO 0 DISKW ' Source ' COVCOB' Fm '(FINIS'
'COPY GENCWS DATA J' Source ' COVCOB' Fm '(APP'
end
return
end
IF FirstWord = StartWord then do
Sub = 0
call CopyLine
aline = ' PERFORM ITD--INIT-COVERAGE.'
call AddLine
return
end
IF Sub = -1 then do
call CopyLine
return
end
IF FirstWord = 'EXEC' then do
In_EXEC = 'YES'
PEnv = 'CICS'
call AnalEXEC
return
end
IF In_EXEC = 'YES' then do
call CopyLine
DO j = 1 to 30
IF word(iline.i,j) = '' then leave
IF strip(word(iline.i,j),,'.') = 'END-EXEC' then do
In_EXEC = 'NO'
end
end
return
end
IF FirstWord = 'GOBACK' | FirstWord = 'GOBACK.' | FirstWord = 'STOP' then do
call AddCover
call AddReport
call CopyLine
return
end
IF FirstWord = 'CALL' then do
IF word(substr(iline.i,8),2) ="'ABEND'" then do
call AddCover
call AddReport
end
ELSE do
call AddCover
end
call CopyLine
return
end
IF FirstWord = 'GOBACK' | FirstWord = 'GOBACK.' | FirstWord = 'STOP' then do
call AddCover
call AddReport
end
Verb = 'Y'
call ChkVerb
IF Verb = 'N' then do
call CopyLine
return
end
call AddCover
call CopyLine
return
ChkVerb:
IF FirstWord = 'MOVE' then return
IF FirstWord = 'IF' then return
IF FirstWord = 'PERFORM' then return
IF FirstWord = 'ACCEPT' then return
IF FirstWord = 'ADD' then return
IF FirstWord = 'ALTER' then return
IF FirstWord = 'CLOSE' then return
IF FirstWord = 'COMPUTE' then return
IF FirstWord = 'DELETE' then return
IF FirstWord = 'DISPLAY' then return
IF FirstWord = 'DIVIDE' then return
IF FirstWord = 'EVALUATE' then return
IF FirstWord = 'EXAMINE' then return
IF FirstWord = 'EXHIBIT' then return
IF FirstWord = 'GENERATE' then return
IF FirstWord = 'GO' then return
IF FirstWord = 'INITIALIZE' then return
IF FirstWord = 'INITIATE' then return
IF FirstWord = 'INSERT' then return
IF FirstWord = 'INSPECT' then return
IF FirstWord = 'MULTIPLY' then return
IF FirstWord = 'ON' then return
IF FirstWord = 'OPEN' then return
IF FirstWord = 'READ' then return
IF FirstWord = 'READY' then return
IF FirstWord = 'REWRITE' then return
IF FirstWord = 'SEARCH' then return
IF FirstWord = 'SEEK' then return
IF FirstWord = 'SEND' then return
IF FirstWord = 'SERVICE' then return
IF FirstWord = 'SET' then return
IF FirstWord = 'SORT' then return
IF FirstWord = 'START' then return
IF FirstWord = 'STRING' then return
IF FirstWord = 'SUBTRACT' then return
IF FirstWord = 'TERMINATE' then return
IF FirstWord = 'TRANSFORM' then return
IF FirstWord = 'UNSTRING' then return
IF FirstWord = 'WRITE' then return
Verb = 'N'
return
AddCover:
IF Coverage = 'NO' then return
Sub = Sub + 1
aline = Space40||'ADD +1 TO ITD--USED ('Sub')'
call AddLine
IF Col80 = ' ' then return
CovLine = left(Space40||"MOVE" "'"Col80"'" "TO ITD--COL80 ("Sub"). ",72)||'COVERAGE'
'EXECIO 1 DISKW GENCOV $TEMP2$ A (FINIS VAR COVLINE'
return
AddReport:
IF Coverage = 'NO' then return
aline = Space40||'PERFORM ITD--REPORT-COVERAGE'
call Addline
return
AddLine:
IF Coverage = 'NO' then return
aline = left(aline' ',72)||'COVERAGE'
'EXECIO 1 DISKW ' Source ' COVCOB' Fm '(VAR ALINE'
return
CopyLine:
IF Coverage = 'NO' | Sub < 1 | substr(iline.i,7,1) ^= ' ' then do
oline = iline.i
end
ELSE do
VerbNo = right('0000000'Sub,7)
oline = left(iline.i,72)||VerbNo||Col80
end
'EXECIO 1 DISKW ' Source ' COVCOB' Fm '(VAR OLINE'
return
Chk24:
IF source = '???????' then queue ' MODE AMODE(24) RMODE(24)'
return
AnalEXEC:
/* Check for END-EXEC on same line */
EXEC_Line = substr(iline.i,8)
DO j = 1 to 30
Temp = strip(word(EXEC_Line,j),,'.')
IF Temp = '' then leave
IF Temp = 'END-EXEC' then do
In_EXEC = 'NO'
leave
end
end
/* Parse to END-EXEC */
m = 0
EXEC.0 = 0
DO j = 0 to 50
k = i + j
EXEC_Line = substr(iline.k,8)
DO l = 1 to 30
IF word(EXEC_Line,l) ^= '' then do
m = m + 1
EXEC.0 = m
EXEC.m = strip(word(EXEC_Line,l),,'.')
end
IF EXEC.m = 'END-EXEC' then leave
end
IF EXEC.m = 'END-EXEC' then leave
end
/* Check Function code */
CICS_Function = EXEC.3
IF CICS_Function = 'ABEND' | CICS_Function = 'RETURN' | CICS_Function = 'XCTL' then do
call AddCover
call AddReport
call CopyLine
return
end
IF CICS_Function ^= 'SEND' then do
call AddCover
call CopyLine
return
end
/* But is it EXEC CICS SEND PAGE RELEASE */
IF EXEC.4 = 'PAGE' & EXEC.5 = 'RELEASE' then do
call AddCover
call AddReport
call CopyLine
return
end
call AddCover
call CopyLine
return
|
© Copyright IT Doctors.co.uk. 2002