/* REXX JSPLIT Reorganize JCL into a neater package Use '(routine name) ?' for HELP-text. Written by Frank Clarke 20041101 rexxhead@yahoo.com Impact Analysis . SYSEXEC SYSUMON . SYSEXEC TRAPOUT Modification History 20050104 fxc handle quoted strings; 20061217 fxc finally working!; 20061218 fxc correct handling of PARMs; 20061219 fxc allow step-renumber; 20061226 fxc allow null parameters; 20070117 fxc fix the problem of spurious x3f's; 20210608 pv chg 'pull' to 'parse pull' in C_RECONSTRUCT 20210608 fxc correct parsing of JOB 20230401 fxc SYSUMON only if not testing 20230726 fxc adjust HELP; 20230803 fxc use hhmm for log file name; 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20230908 fxc set log lrecl to 255; 20240308 fxc chg dollar-sign to @ everywhere; 20240309 fxc add logpref; */ address ISREDIT /* REXXSKEL ver.20040227 */ "MACRO (opts)" if rc = 20 then do /* ISREDIT not available */ address TSO call TOOLKIT_INIT /* conventional start-up -*/ helpmsg = exec_name "is an EDIT macro" call HELP /* and don't come back */ end upper opts info = opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = Trace("O"); rc = Trace(tv) call A_INIT /* -*/ address TSO "NEWSTACK" call B_ONE_LINE /* -*/ call C_RECONSTRUCT /* -*/ address TSO "DELSTACK" call ZB_SAVELOG /* -*/ if \sw.nested then call DUMP_QUEUE /* -*/ exit /*@ JSPLIT */ /* FRAGORDR specifies the order in which JCL fragments will be reapplied when the JCL is reconstructed. . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address ISREDIT if tv = 'N' then, /* only if not testing */ "SYSUMON USER" Userid() "TOOL" exec_name call AA_SETUP_LOG /* -*/ sw.0Reset_Steps = SWITCH("RESTEP") parse value "" with, frag. fragordr. , stash taglist , tagvalue text slug comm parse value "0 0 0 0 0 0 0 0 0 0 0 0 0 0" with, top bottom line# . fragordr.DD = "DUMMY SYSOUT OUTPUT DSN DISP UNIT VOL SPACE DCB", "RECFM LRECL BLKSIZE" fragordr.EXEC = "PGM PROC PARM COND REGION TIME" fragordr.JOB = "0_AI 0_PN USER PASSWORD REGION TIME COND", "CLASS MSGCLASS MSGLEVEL NOTIFY" "RESET" "RENUM" "UNNUM" "(bottom) = LINENUM .zl" /* last line */ top = 1 "F FIRST P'^'" "LABEL .zcsr = .JS 0" /* mark JCL-start */ "(origcaps) = CAPS" "CAPS OFF" return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ AA_SETUP_LOG: /*@ */ if branch then call BRANCH address TSO parse value "0" with, log# log. parse value Date("S") Time("S") Time("N") with, yyyymmdd sssss hhmmss . hhmmss = Space( Translate( hhmmss,' ',':' ) ,0 ) parse var yyyymmdd 4 yrdigit 5 mm 7 dd /* 9 12 14 maybe */ if Pos(yrdigit,"13579") > 0 then mm = mm + 12 /* mm=24 */ logtag = Substr("ABCDEFGHIJKLMNOPQRSTUVWX",mm,1) /* logtag=X */ subid = logtag""dd""Left( hhmmss,4 ) /* X141743 ? */ vb4k.0 = "NEW CATALOG UNIT(SYSDA) SPACE(1 5) TRACKS", "RECFM( V B ) LRECL( 255 ) BLKSIZE( 0 )" logdsn = "@LOG."exec_name"."subid".LIST" logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref exec_name , "started by" Userid() yyyymmdd hhmmss) call ZL_LOGMSG( logpref "Running from" FIND_ORIGIN() ) return /*@ AA_SETUP_LOG */ /* Read the JCL bottom-up separating each statement into the three canonical tokens plus all the comments collected in a fourth token. Push each line onto the stack to maintain original order. Queue each block of comment right-justified in a field of 71. . ----------------------------------------------------------------- */ B_ONE_LINE: /*@ */ if branch then call BRANCH address ISREDIT x3e = '3E'x x3f = '3F'x logpref = "("Branch("ID")")" do line# = bottom to top by -1 "(text) = LINE" line# ptf = Pos("'",text) ptl = LastPos("'",text) if ptf > 0 then, /* there is a quote */ if ptf < ptl then do /* there are two quotes */ slab = Translate(Substr(text,ptf,ptl-ptf+1),, x3f , " " ) /* blanks to special */ text = Overlay(slab,text,ptf) sw.0_dotted = 1 end if Left(text,2) <> "//" then do /* non-JCL */ push Strip(text,"T") /* top of stack */ iterate end else text = Left(text,72) /* lop numbers */ if Left(text,3) = "//*" then do /* comment */ push Strip(text,"T") /* top of stack */ iterate end /* It's REAL JCL... */ parse var text . verb . /* 2nd token */ if WordPos(verb,"EXEC PROC DD") > 0 then do parse var text w1 w2 w3 comm /* //ddname dd dsn=... */ if comm <> "" then do comm = Right(comm,71) comm = Overlay("//*",comm,1) push comm end slug = w1 w2 Space(w3 slug,0) push slug /* top of stack */ call ZL_LOGMSG( logpref exec_name slug) parse value "" with slug comm iterate /* next line up */ end /* a verb I know */ else, if WordPos(verb,"JOB") > 0 then do parse var text w1 w2 w3 w3 = Strip(w3) pt = LastPos(",",w3) + 1 /* find the last comma */ if Substr(w3,pt,1) == ' ' then, /* text beyond? */ parse var w3 w3 =(pt) comm /* split off comment */ if comm <> "" then do comm = Right(comm,71) comm = Overlay("//*",comm,1) push comm end w3 = Translate(w3,x3f," ") /* spaces to special */ slug = w1 w2 Space(w3 slug,0) push slug /* top of stack */ call ZL_LOGMSG( logpref exec_name slug ) parse value "" with slug comm iterate /* next line up */ end /* a verb I know */ else, if WordPos(verb,"PRINT INCLUDE OUTPUT SET JCLLIB") > 0 then, do parse var text w1 w2 w3 comm /* //ddname dd dsn=... */ if comm <> "" then do comm = Right(comm,71) comm = Overlay("//*",comm,1) push comm end slug = w1 w2 Space(w3 x3e slug,0) push slug /* top of stack */ call ZL_LOGMSG( logpref exec_name slug ) parse value "" with slug comm iterate end /* a verb I know */ else, if Left(verb,1) = "'" then do /* continued PARM */ parse var text . text /* take it all */ ptf = Pos("'",text) + 1 /* start of parm-text */ parse var text "'" w2 "'" /* extract text */ w2 = Translate(w2,x3f," ") /* spaces to special */ text = Overlay(w2 ,text,ptf) /* insert between quotes */ parse var text text comm if comm <> "" then do comm = Right(comm,71) comm = Overlay("//*",comm,1) push comm end slug = Space(text slug,0) /* concat */ sw.0_dotted = 1 iterate end /* a verb I know */ /* it must be a continued line... */ parse var text w1 w2 comm if comm <> "" then do comm = Right(comm,71) comm = Overlay("//*",comm,1) push comm end slug = w2""x3e""slug /* concat */ end /* bottom to top */ return /*@ B_ONE_LINE */ /* The original JCL has been one-lined and can be found on the stack. Split to component parts, reassemble, and reconstruct the JCL. . ----------------------------------------------------------------- */ C_RECONSTRUCT: /*@ */ c_tv = trace() /* what setting at entry ? */ rc = Trace("O"); rc = trace(c_tv) if branch then call BRANCH address ISREDIT steplist = "" step# = 10 newstep. = "" do queued() parse pull line /* maintain case */ if Left(line,3) = "//*" then do /* comment */ line = Translate(line," ",x3f) /* special to blanks */ queue line iterate end if Left(line,2) <> "//" then do /* non-JCL */ line = Translate(line," ",x3f) /* special to blanks */ queue line iterate end frag. = "" /* re-init */ parse var line w1 w2 w3 w3 = Strip(w3,"T",x3e) taglist = "" /* JOB goes in 12; EXEC goes in 12; DD goes in 13 followed by 2 blanks; otherwise space1. */ select when w2="DD" then do if sw.0Reset_Steps then do call CR_REPL_STEP /* replace stepname -*/ end if Length(w1) < 12 then, slug = Left(w1,11) w2 else slug = w1 w2 call CD_PARSE_DD /* -*/ end /* DD */ when w2="EXEC" then do if sw.0Reset_Steps then do parse var w1 "//" stepnm . newstep = "STEP"Right(step#,3,0) if stepnm <> newstep then do if WordPos(stepnm,steplist) = 0 then do steplist = steplist stepnm newstep.stepnm = newstep w1 = "//"newstep step# = step# + 10 end else do sw.0Reset_Steps = 0 zerrsm = "Stepping halted" zerrlm = "Duplicate stepnames detected. ", "You should re-work this ", "JCL manually." address ISPEXEC "SETMSG MSG(ISRZ002)" exit end end end if Length(w1) < 11 then, slug = Left(w1,10) w2 else slug = w1 w2 call CE_PARSE_EXEC /* -*/ end /* EXEC */ when w2="JOB" then do if Length(w1) < 11 then, slug = Left(w1,10) w2 else slug = w1 w2 call CJ_PARSE_JOB /* -*/ end /* JOB */ when w2="PROC" then do if Length(w1) < 11 then, slug = Left(w1,10) w2 else slug = w1 w2 call CP_PARSE_PROC /* -*/ end /* PROC */ otherwise do if sw.0Reset_Steps then do call CR_REPL_STEP /* replace stepname -*/ end slug = Space(w1 w2 w3,1) call CU_PARSE_UNDEF /* -*/ end end /* select */ end /* queued */ if noupdt then return do queued() /* every stacked line */ parse pull line "LINE_BEFORE .JS = (line)" end /* queued */ "RESET" "X ALL .JS .ZL" /* exclude original */ "DEL ALL X" /* ...and delete */ "F FIRST P'^'" /* position to top */ return /*@ C_RECONSTRUCT */ /* Reconstruct a DD statement. . ----------------------------------------------------------------- */ CD_PARSE_DD: /*@ */ cd_tv = trace() /* what setting at entry ? */ if branch then call BRANCH address ISREDIT if Pos( "," , w3 ) = 0 then do /* first token * or DUMMY */ w3 = Translate(w3 ," ",x3f) /* special to blanks */ queue slug Strip(w3) /* slug is w1+w2 */ parse value "" with w1 w2 w3 return end parse var w3 tag "=" if Pos( "," , tag ) > 0 then do /* first token may be DUMMY */ parse var w3 notag "," w3 /* identify */ taglist = "DUMMY" taglist frag.DUMMY = notag end call CX_DEFRAG /* sets frag.tag=tagvalue -*/ /* E.g.: frag.DISP=(SHR,PASS) */ /* Process FRAGORDER first, eliminating tags from TAGLIST */ wrkordr = fragordr.DD suffix = "," do cz = 1 to Words(wrkordr) /* each word */ token = Word(wrkordr,cz) /* isolate one */ if Words(taglist) = 0 then leave if Words(taglist) = 1 then suffix = "" wpt = WordPos(token,taglist) /* locate */ if wpt > 0 then do slug = Left(slug,14) token"="frag.token /* if slug is too long, crack it in pieces. */ if Length(slug) > 65 then, do call CZ_SPLIT_LONG /* sets logpref -*/ end else, do slug = Translate(slug," ",x3e) /* special to blanks */ slug = Translate(slug," ",x3f) /* special to blanks */ end queue Strip(slug)suffix logpref = "("Branch("ID")")" call ZL_LOGMSG( exec_name logpref Strip(slug)suffix ) slug = Left("//",14) taglist = DelWord(taglist,wpt,1) /* snip */ end /* frag.token */ end /* cz */ rc = Trace("O"); rc = trace(cd_tv) /* Process remaining tags in TAGLIST */ do cz = 1 to Words(taglist) /* each word */ token = Word(taglist,cz) /* isolate one */ if Words(taglist) = cz then suffix = "" /* if frag.token <> "" then do */ slug = slug token"="frag.token""suffix /* if slug is too long, crack it in pieces. */ if Length(slug) > 65 then, do call CZ_SPLIT_LONG /* sets logpref -*/ end else, do slug = Translate(slug," ",x3e) /* special to blanks */ slug = Translate(slug," ",x3f) /* special to blanks */ end queue Strip(slug)suffix logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref exec_name Strip(slug)suffix ) slug = Left("//",14) /* end */ /* frag.token */ end /* cz */ logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref exec_name queued() "lines queued") return /*@ CD_PARSE_DD */ /* Reconstruct an EXEC statement. Order of the fragments: first glyph (PGM=, PROC=, or procname); if a procedure (not 'PGM='), then each phrase in alpha-order; else PARM COND REGION TIME. . ----------------------------------------------------------------- */ CE_PARSE_EXEC: /*@ */ if branch then call BRANCH address ISREDIT if Pos( "PGM=" , w3 ) = 0 &, Pos( "PROC=" , w3 ) = 0 then, w3 = "PROC="w3 /* identify */ call CX_DEFRAG /* sets frag.tag=tagvalue -*/ /* E.g.: frag.DISP=(SHR,PASS) */ wrkordr = fragordr.EXEC suffix = "," do cz = 1 to Words(wrkordr) /* each word */ token = Word(wrkordr,cz) /* isolate one */ if Words(taglist) = 0 then leave if Words(taglist) = 1 then suffix = "" wpt = WordPos(token,taglist) /* locate */ if wpt > 0 then do slug = slug token"="frag.token /* if slug is too long, crack it in pieces. */ if Length(slug) > 65 then, do call CZ_SPLIT_LONG /* -*/ end else, do slug = Translate(slug," ",x3e) /* special to blanks */ slug = Translate(slug," ",x3f) /* special to blanks */ end queue Strip(slug)suffix logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref exec_name Strip(slug)suffix) slug = Left("//",14) taglist = DelWord(taglist,wpt,1) /* snip */ end /* wpt */ end /* cz */ do cz = 1 to Words(taglist) /* each word */ token = Word(taglist,cz) /* isolate one */ if Words(taglist) = cz then suffix = "" /* if frag.token <> "" then do */ if Right(frag.token,1) = x3e then, frag.token = Delstr(frag.token,, /* snip! */ Length(frag.token),1) slug = slug token"="frag.token""suffix slug = Translate(slug," ",x3e) /* special to blanks */ slug = Translate(slug," ",x3f) /* special to blanks */ queue slug logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref exec_name slug ) slug = Left("//",14) /* end */ /* frag.token */ end /* cz */ logpref = "("Branch("ID")")" call ZL_LOGMSG( logpref exec_name queued() "lines queued") return /*@ CE_PARSE_EXEC */ /* Reconstruct a JOB statement. Order of the fragments: Acctg info and programmer name on first line; then USER PASSWORD REGION TIME COND CLASS MSGCLASS MSGLEVEL NOTIFY followed by any others. 'Acctg info' may be missing, and may start with a "(" if present. If acctg-info is missing and progr-name is not, progr-name will start with a ",". It appears the only practical way to determine the configuration is to parse out all the tag/value sets and the rest (if anything) is acctg-info and/or progr-name. . ----------------------------------------------------------------- */ CJ_PARSE_JOB: /*@ */ if branch then call BRANCH address ISREDIT call CJ0_FIND_TAGS /* separate ai_pn and kwparms-*/ /* On return, holds the positional data. identifies the tags present in . is the location in of the start of the information for . . if AI_PN starts with a ",", acctg-info is missing and all that remains is progr-name. if AI_PN starts with a "(", it's acctg-info to the ")" and whatever follows is progr-name. */ parse value "" with stash taglist pgmr acctg t1 poslist do Words( tags ) /* each valid tag */ parse value tags t1 with t1 tags poslist = poslist posval.t1 end /* tags */ tags = tags t1 poslist = STRSORT( poslist , "D" ) /* last first */ do Words( poslist ) /* */ parse var poslist loc poslist /* furthest right */ kwset = Substr( w3 , loc ) w3 = Delstr( w3 , loc ) w3 = Strip( w3,"T",x3e ) w3 = Strip( w3,"T","," ) parse var kwset tag "=" kwset frag.tag = kwset /* assign tag=value to frag. */ end /* poslist */ if ai_pn <> "" then, if Left(ai_pn , 1) = "," then do pgmr = ai_pn acctg = "" end /* starts with comma */ else, if Pos( ",'" , ai_pn ) > 0 then do /* start of pgmr */ parse var ai_pn acctg ",'" pgmr if acctg <> "" then , pgmr = "'"pgmr else pgmr = ",'"pgmr /* needs a leading comma */ end /* progr-name */ else, acctg = ai_pn /* can't parse it */ /* parse accounting information, if any */ logpref = "("Branch("ID")")" if acctg <> "" then do frag.0_AI = acctg tags = tags 0_AI call ZL_LOGMSG( logpref exec_name "(Acctg info)="acctg ) end /* parse programmer name, if any */ if pgmr <> "" then do frag.0_PN = pgmr tags = tags 0_PN call ZL_LOGMSG( logpref exec_name "(PgmrName)="pgmr ) end wrkordr = fragordr.JOB taglist = tags suffix = "," do cz = 1 to Words(wrkordr) /* each word */ if Words(taglist) = 0 then leave if Words(taglist) = 1 then suffix = "" token = Word(wrkordr,cz) /* isolate one */ wpt = WordPos(token,taglist) /* locate */ if wpt > 0 then do frag.token = Strip(frag.token) if Left(token,1) = 0 then, /* special tag */ slug = slug frag.token""suffix else, /* regular tag */ slug = slug token"="frag.token""suffix slug = Translate(slug," ",x3e) /* special to blanks */ slug = Translate(slug," ",x3f) /* special to blanks */ queue slug call ZL_LOGMSG( logpref exec_name slug) slug = Left("//",14) taglist = DelWord(taglist,wpt,1) /* shorten */ end /* wpt */ end /* cz */ do cz = 1 to Words(taglist) /* each word */ token = Word(taglist,cz) /* isolate one */ if Words(taglist) = cz then suffix = "" frag.token = Strip(frag.token,,x3e) /* snip! */ frag.token = Strip(frag.token) /* snip! */ slug = slug token"="frag.token""suffix slug = Translate(slug," ",x3e) /* special to blanks */ slug = Translate(slug," ",x3f) /* special to blanks */ queue slug call ZL_LOGMSG( logpref exec_name slug ) slug = Left("//",14) end /* cz */ call ZL_LOGMSG( logpref exec_name queued() "lines queued" ) return /*@ CJ_PARSE_JOB */ /* The complete list of known tag/value keywords for JOB are: ADDRSPC BYTES CARDS CCSID CLASS COND DSENQSHR EMAIL GDGBIAS GROUP JESLOG JOBRC LINES MEMLIMIT MSGCLASS MSGLEVEL NOTIFY PAGES PASSWORD PERFORM PRTY RD REGION REGIONX RESTART SECLABEL SCHENV SYSAFF SYSTEM TIME TYPRUN UJOBCORR USER Locate each of these in and then select the leftmost, isolating it, so that the remainder holds the positional values, 'accounting info' and 'programmer name' (if present at all). . ----------------------------------------------------------------- */ CJ0_FIND_TAGS: /*@ */ if branch then call BRANCH address TSO j0_tv = Trace() /* what setting at entry? */ startpt = 99999 /* very high */ wt = "" posval. = 99999 /* very high */ tags = "ADDRSPC BYTES CARDS CCSID CLASS COND DSENQSHR EMAIL", "GDGBIAS GROUP JESLOG JOBRC LINES MEMLIMIT MSGCLASS", "MSGLEVEL NOTIFY PAGES PASSWORD PERFORM PRTY RD", "REGION REGIONX RESTART SECLABEL SCHENV SYSAFF", "SYSTEM TIME TYPRUN UJOBCORR USER" do Words(tags) parse value tags wt with wt tags posval.wt = Pos( wt"=" , w3 ) if posval.wt = 0 then, parse value '99999' with posval.wt wt . /* ZAP, gone! */ else startpt = Min( startpt , posval.wt ) end /* tags */ rc = Trace("O"); rc = Trace(j0_tv) tags = Space(tags wt , 1 ) /* 'leftmost' is the location of the first tag beyond accounting-info and programmer-name -- if any. */ if tags <> "" then, if startpt > 0 then parse var w3 ai_pn =(startpt) . ai_pn = Strip( ai_pn,"T",x3e ) ai_pn = Strip( ai_pn,"T","," ) return /*@ CJ0_FIND_TAGS */ /* . ----------------------------------------------------------------- */ CP_PARSE_PROC: /*@ */ if branch then call BRANCH address TSO call CX_DEFRAG /* sets frag.tag=tagvalue -*/ /* E.g.: frag.DISP=(SHR,PASS) */ suffix = "," logpref = "("Branch("ID")")" do cz = 1 to Words(taglist) /* each word */ token = Word(taglist,cz) /* isolate one */ if Words(taglist) = cz then suffix = "" if Right(frag.token,1) = x3e then, frag.token = Delstr(frag.token,, /* snip! */ Length(frag.token),1) slug = slug token"="frag.token""suffix slug = Translate(slug," ",x3f) /* special to blanks */ slug = Translate(slug," ",x3e) /* special to blanks */ queue slug call ZL_LOGMSG( logpref exec_name slug) slug = Left("//",14) end /* cz */ call ZL_LOGMSG( logpref exec_name queued() "lines queued" ) return /*@ CP_PARSE_PROC */ /* Do any of the changed stepnames appear in W3? Fix them. Looking for "DSN=*.{ostep}." ",{ostep})" (in COND) "IF {ostep}." "IF ^{ostep}." . ----------------------------------------------------------------- */ CR_REPL_STEP: /*@ */ if branch then call BRANCH address TSO do crz = 1 to Words(steplist) ostep = Word(steplist,crz) nstep = newstep.ostep pt = Pos(ostep,w3) start = 1 if pt > 0 then do olda = ostep"." ; newa = nstep"." oldb = ","ostep")" ; newb = ","nstep")" end do 2 while pt > 0 parse var w3 front (olda) back if back <> "" then, w3 = front""newa""back parse var w3 front (oldb) back if back <> "" then, w3 = front""newb""back pt = Pos(ostep,w3) end end return /*@ CR_REPL_STEP */ /* The verb is unrecognized. Report it and do a generalized parse-and-queue. If the line contains X3E characters, split at those points. . ----------------------------------------------------------------- */ CU_PARSE_UNDEF: /*@ */ if branch then call BRANCH address TSO logpref = "("Branch("ID")")" slug = Translate(slug," ",x3f) /* special to blanks */ if Right(slug,1) = x3e then, slug = Delstr(slug,, /* snip! */ Length(slug),1) pt = Pos( x3e , slug ) if pt > 0 then do /* line was originally split */ do while pt > 0 parse var slug slug (x3e) frag.token slug = Translate(slug," ",x3f) /* special to blanks */ queue Strip(slug) /* already has a comma! */ call ZL_LOGMSG( logpref exec_name slug) slug = Left("//",14) frag.token pt = Pos( x3e , slug ) end /* pt */ end /* pt */ slug = Translate(slug," ",x3f) /* special to blanks */ queue slug call ZL_LOGMSG( logpref exec_name slug) call ZL_LOGMSG( logpref exec_name queued() "lines queued") return /*@ CU_PARSE_UNDEF */ /* contains the first 2 tokens of the text. contains all the remainder of the text. Defragment W3. . How to DEFRAG: get the first token (TKN=......) walk the rest of the string stacking and destacking parens and quotes. when the current character is a comma (or end-of-string) and there are no unmatched parens or quotes, store as the tagvalue. . ----------------------------------------------------------------- */ CX_DEFRAG: /*@ */ if branch then call BRANCH address ISREDIT logpref = "("Branch("ID")")" do while w3 <> "" /* until completely parsed */ parse var w3 tag "=" w3 stash = "" /* reinit */ call CXA_CHOP_W3 /* associate tags with values */ call ZL_LOGMSG( logpref exec_name tag"="tagvalue ) end /* w3 */ call ZL_LOGMSG( logpref exec_name "Taglist for" w2":" taglist ) return /*@ CX_DEFRAG */ /* Find the tagvalue that goes with the current tag. Find a comma in a position such that any quotes or parentheses before it are balanced by offsetting characters. . ----------------------------------------------------------------- */ CXA_CHOP_W3: /*@ */ if branch then call BRANCH address TSO @z = Trace("O") /* trace OFF */ do cx = 1 to Length(w3) /* each character */ this1 = Substr(w3,cx,1) /* isolate the character */ if this1 = "(" then stash = Space(this1 stash,0) else, if this1 = ")" then, if Left(stash,1) = "(" then stash = Substr(stash,2) else nop else, if this1 = "'" then, if Left(stash,1) = "'" then stash = Substr(stash,2) else stash = Space(this1 stash,0) else, if this1 = "," then, if stash = "" then do /* balanced */ tagvalue = Substr(w3,1,cx-1) frag.tag = tagvalue taglist = taglist tag w3 = Delstr(w3,1,cx) /* snip tagvalue from w3 */ if Left(w3,1) = x3e then, w3 = Substr(w3,2) /* snip the x3e */ leave end if cx = Length(w3) then do frag.tag = w3 tagvalue = w3 taglist = Space(taglist tag,1) w3 = "" end end /* cx */ return /*@ CXA_CHOP_W3 */ /* SLUG is ready-to-write except that it's too long to be written on a single line. Split and queue all but the last piece. This long text may contain '3E'x characters indicating original line-breaks. If present, split there. . On return, 'slug' must be fully-formed and ready to be queued. . ----------------------------------------------------------------- */ CZ_SPLIT_LONG: Procedure expose, /*@ */ (tk_globalvars) log. log# frag. token slug x3f x3e, suffix if branch then call BRANCH address TSO /* First check for comma in the string */ if Length(slug) < 72 then, if Pos(",",slug) = 0 then return /* can't be split */ logpref = "("Branch("ID")")" /* Next check for '3E'x in the string */ pt = Pos( x3e , slug ) if pt > 0 then do /* line was originally split */ do while pt > 0 parse var slug slug (x3e) frag.token slug = Translate(slug," ",x3f) /* special to blanks */ queue Strip(slug) /* already has a comma! */ call ZL_LOGMSG( logpref exec_name slug ) slug = Left("//",14) frag.token pt = Pos( x3e , slug ) end /* pt */ return end /* pt */ parse var slug slug "=" frag.token delim = Left(frag.token,1) if delim <> "(" then, frag.token = "("frag.token")" start = 2 /* after the banana */ do while Length(frag.token) > 45 /* Find a comma not inside unbalanced quotes/parens */ stack = "" do cz = start to Length(frag.token) char = Substr(frag.token,cz,1) if Pos(char , "'()" ) > 0 then do if char = "'" then, if Left(stack,1) = "'" then, stack = Substr(stack,2) /* snip */ else stack = "'"stack /* add */ else, if char = "(" then, stack = "("stack /* add */ else, if char = ")" then, if Left(stack,1) = "(" then, stack = Substr(stack,2) /* snip */ end /* special character */ else, if char = "," then, if stack = "" then, /* no unclosed subparms */ do slug = slug Substr(frag.token,1,cz)"," slug = Translate(slug," ",x3e) slug = Translate(slug," ",x3f) queue slug call ZL_LOGMSG( logpref exec_name slug ) slug = Left("//",14) frag.token = Substr(frag.token,cz+1) start = 1 leave /* (cz, I hope...) */ end /* no unclosed subparms */ end /* cz */ end /* while len > 50 */ return /*@ CZ_SPLIT_LONG */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* Find where code was run from. It assumes cataloged data sets. Original by Doug Nadel With SWA code lifted from Gilbert Saint-flour's SWAREQ exec . ----------------------------------------------------------------- */ FIND_ORIGIN: Procedure /*@ */ answer="* UNKNOWN *" /* assume disaster */ Parse Source . . name dd ds . /* get known info */ Call listdsi(dd "FILE") /* get 1st ddname from file */ Numeric digits 10 /* allow up to 7FFFFFFF */ If name = "?" Then /* if sequential exec */ answer="'"ds"'" /* use info from parse source */ Else /* now test for members */ If sysdsn("'"sysdsname"("name")'")="OK" Then /* if in 1st ds */ answer="'"sysdsname"("name")'" /* go no further */ Else /* hooboy! Lets have some fun!*/ Do /* scan tiot for the ddname */ tiotptr=24+ptr(12+ptr(ptr(ptr(16)))) /* get ddname array */ tioelngh=c2d(stg(tiotptr,1)) /* nength of 1st entry */ Do Until tioelngh=0 | tioeddnm = dd /* scan until dd found */ tioeddnm=strip(stg(tiotptr+4,8)) /* get ddname from tiot */ If tioeddnm <> dd Then /* if not a match */ tiotptr=tiotptr+tioelngh /* advance to next entry */ tioelngh=c2d(stg(tiotptr,1)) /* length of next entry */ End If dd=tioeddnm Then, /* if we found it, loop through the data sets doing an swareq for each one to get the dsname */ Do Until tioelngh=0 | stg(4+tiotptr,1)<> " " tioejfcb=stg(tiotptr+12,3) jfcb=swareq(tioejfcb) /* convert SVA to 31-bit addr */ dsn=strip(stg(jfcb,44)) /* dsname JFCBDSNM */ vol=storage(d2x(jfcb+118),6) /* volser JFCBVOLS (not used) */ If sysdsn("'"dsn"("name")'")='OK' Then, /* found it? */ Leave /* we is some happy campers! */ tiotptr=tiotptr+tioelngh /* get next entry */ tioelngh=c2d(stg(tiotptr,1)) /* get entry length */ End answer="'"dsn"("name")'" /* assume we found it */ End Return answer /*@ FIND_ORIGIN */ /* . ----------------------------------------------------------------- */ ptr: Return c2d(storage(d2x(Arg(1)),4)) /*@ */ /* . ----------------------------------------------------------------- */ stg: Return storage(d2x(Arg(1)),Arg(2)) /*@ */ /* . ----------------------------------------------------------------- */ SWAREQ: Procedure /*@ */ If right(c2x(Arg(1)),1) \= 'F' Then /* SWA=BELOW ? */ Return c2d(Arg(1))+16 /* yes, return sva+16 */ sva = c2d(Arg(1)) /* convert to decimal */ tcb = c2d(storage(21c,4)) /* TCB PSATOLD */ tcb = ptr(540) /* TCB PSATOLD */ jscb = ptr(tcb+180) /* JSCB TCBJSCB */ qmpl = ptr(jscb+244) /* QMPL JSCBQMPI */ qmat = ptr(qmpl+24) /* QMAT QMADD */ Do While sva>65536 qmat = ptr(qmat+12) /* next QMAT QMAT+12 */ sva=sva-65536 /* 010006F -> 000006F */ End return ptr(qmat+sva+1)+16 /*@ SWAREQ */ /* . ----------------------------------------------------------------- */ ZB_SAVELOG: /*@ */ if branch then call BRANCH address TSO if Symbol("LOG#") = "LIT" then return /* not yet set */ "ALLOC FI(@LOG) DA("logdsn") REU" vb4k.0 "EXECIO" log# "DISKW @LOG (STEM LOG. FINIS" "FREE FI(@LOG)" return /*@ ZB_SAVELOG */ /* . ----------------------------------------------------------------- */ ZL_LOGMSG: Procedure expose, /*@ */ (tk_globalvars) log. log# rc = Trace("O") address TSO parse arg msgtext parse value log#+1 msgtext with, zz log.zz 1 log# . if monitor then say, msgtext return /*@ ZL_LOGMSG */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address ISPEXEC "CONTROL DISPLAY SAVE" address TSO;"CLEAR" ; say "" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" reorganizes JCL to place one-phrase-per-line (where " say " possible). Phrases are reordered as follows: " say " " say " JOB (AI PN) USER PASSWORD REGION TIME COND ... " say " " say " EXEC PGM PROC PARM COND REGION TIME ... " say " " say " DD DUMMY SYSOUT OUTPUT DSN DISP UNIT VOL " say " SPACE DCB ... " say " " say " Syntax: "ex_nam" RESTEP " say " " say " RESTEP causes all stepnames to be reset (if necessary) to " say " STEP010, STEP020, etc. COND specifications and " say " backward references are altered to match. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " say " " say " MONITOR displays key information throughout processing. " say " " say " BRANCH show all paragraph entries. " say " " say " TRACE tv will use value following TRACE to place the " say " execution in REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO "ex_nam" parameters (( debug-options " say " " say " For example " say " " say " TSO "ex_nam" (( MONITOR TRACE ?R " if sysvar("SYSISPF") = "ACTIVE" then, address ISPEXEC "CONTROL DISPLAY REFRESH" exit /*@ HELP */ /* . ----------------------------------------------------------------- */ BRANCH: Procedure expose, /*@ */ sigl exec_name rc = trace("O") /* we do not want to see this */ arg brparm . origin = sigl /* where was I called from ? */ do currln = origin to 1 by -1 /* inch backward to label */ if Right(Word(Sourceline(currln),1),1) = ":" then do parse value sourceline(currln) with pgfname ":" . /* Label */ leave ; end /* name */ end /* currln */ select when brparm = "NAME" then return(pgfname) /* Return full name */ when brparm = "ID" then do /* wants the prefix */ parse var pgfname pgfpref "_" . /* get the prefix */ return(pgfpref) end /* brparm = "ID" */ otherwise say left(sigl,6) left(pgfname,40) exec_name "Time:" time("L") end /* select */ return /*@ BRANCH */ /* . ----------------------------------------------------------------- */ DUMP_QUEUE: /*@ Take whatever is in stack */ rc = trace("O") /* and write to the screen */ address TSO arg mode . "QSTACK" /* how many stacks? */ stk2dump = rc - tk_init_stacks /* remaining stacks */ if stk2dump = 0 & queued() = 0 then return if mode <> "QUIET" then, say "Total Stacks" rc , /* rc = #of stacks */ " Begin Stacks" tk_init_stacks , /* Stacks present at start */ " Excess Stacks to dump" stk2dump do dd = rc to tk_init_stacks by -1 /* empty each one. */ if mode <> "QUIET" then, say "Processing Stack #" dd " Total Lines:" queued() do queued();parse pull line;say line;end /* pump to the screen */ "DELSTACK" /* remove stack */ end /* dd = 1 to rc */ return /*@ DUMP_QUEUE */ /* Handle CLIST-form keywords added 20020513 . ----------------------------------------------------------------- */ CLKWD: Procedure expose info /*@ hide all except info */ arg kw kw = kw"(" /* form is 'KEY(DATA)' */ kw_pos = Pos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ rtpt = Pos(") ",info" ",kw_pos) /* locate end-paren */ slug = Substr(info,kw_pos,rtpt-kw_pos+1) /* isolate */ info = Delstr(info,kw_pos,rtpt-kw_pos+1) /* excise */ parse var slug (kw) slug /* drop kw */ slug = Reverse(Substr(Reverse(Strip(slug)),2)) return slug /*@CLKWD */ /* Handle multi-word keys 20020513 . ----------------------------------------------------------------- */ KEYWD: Procedure expose info /*@ hide all vars, except info*/ arg kw /* form is 'KEY DATA' */ kw_pos = wordpos(kw,info) /* find where it is, maybe */ if kw_pos = 0 then return "" /* send back a null, not found*/ kw_val = word(info,kw_pos+Words(kw))/* get the next word */ info = Delword(info,kw_pos,2) /* remove both */ return kw_val /*@ KEYWD */ /* . ----------------------------------------------------------------- */ KEYPHRS: Procedure expose, /*@ */ info helpmsg exec_name /* except these three */ arg kp /* form is 'KEY ;: DATA ;:' */ wp = wordpos(kp,info) /* where is it? */ if wp = 0 then return "" /* not found */ front = subword(info,1,wp-1) /* everything before kp */ back = subword(info,wp+1) /* everything after kp */ parse var back dlm back /* 1st token must be 2 bytes */ if length(dlm) <> 2 then /* Must be two bytes */ helpmsg = helpmsg, "Invalid length for delimiter("dlm") with KEYPHRS("kp")" if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter("dlm") with KEYPHRS("kp")" if helpmsg <> "" then call HELP /* Something is wrong -*/ parse var back kpval (dlm) back /* get everything b/w delim */ info = front back /* restore remainder */ return Strip(kpval) /*@ KEYPHRS */ /* . ----------------------------------------------------------------- */ NOVALUE: /*@ */ say exec_name "raised NOVALUE at line" sigl say " " say "The referenced variable is" condition("D") say " " zsigl = sigl signal SHOW_SOURCE /*@ NOVALUE */ /* . ----------------------------------------------------------------- */ SHOW_SOURCE: /*@ */ call DUMP_QUEUE /* Spill contents of stacks -*/ if sourceline() <> "0" then /* to screen */ say sourceline(zsigl) rc = trace("?R") nop exit /*@ SHOW_SOURCE */ /* . ----------------------------------------------------------------- */ SS: Procedure /*@ Show Source */ arg ssbeg ssct . /* 'call ss 122 6' maybe */ if ssct = "" then ssct = 10 if \datatype(ssbeg,"W") | \datatype(ssct,"W") then return ssend = ssbeg + ssct do ssii = ssbeg to ssend ; say Strip(sourceline(ssii),'T') ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw /* form is 'KEY' */ sw_val = Wordpos(kw,info) > 0 /* exists = 1; not found = 0 */ if sw_val then /* exists */ info = Delword(info,Wordpos(kw,info),1) /* remove it */ return sw_val /*@ SWITCH */ /* . ----------------------------------------------------------------- */ SYNTAX: /*@ */ errormsg = exec_name "encountered REXX error" rc "in line" sigl":", errortext(rc) say errormsg zsigl = sigl signal SHOW_SOURCE /*@ SYNTAX */ /* Can call TRAPOUT. . ----------------------------------------------------------------- */ TOOLKIT_INIT: /*@ */ address TSO info = Strip(opts,"T",")") /* clip trailing paren */ parse source sys_id how_invokt exec_name DD_nm DS_nm, as_invokt cmd_env addr_spc usr_tokn parse value "" with tv helpmsg . parse value 0 "ISR00000 YES" "Error-Press PF1" with, sw. zerrhm zerralrm zerrsm if Word(opts ,1) = "?" then call HELP /* I won't be back -*/ if SWITCH("TRAPOUT") then do "TRAPOUT" exec_name parms "(( TRACE R" info exit end /* trapout */ sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" "QSTACK" ; tk_init_stacks = rc /* How many stacks? */ parse value SWITCH("BRANCH") SWITCH("MONITOR") SWITCH("NOUPDT") with, branch monitor noupdt . parse value mvsvar("SYSNAME") sysvar("SYSNODE") with, #tk_cpu node . parse value KEYWD("TRACE") "N" with tv . tk_globalvars = "exec_name tv helpmsg sw. zerrhm zerralrm ", "zerrsm zerrlm tk_init_stacks branch monitor ", "noupdt" call LOCAL_PREINIT /* for more opts -*/ return /*@ TOOLKIT_INIT */