/* REXX VCX Re-write of Jim Connelley's VC to take advantage of LISTCSUM Use '(routine name) ?' for HELP-text. Written by Frank Clarke 20020507 rexxhead@yahoo.com Impact Analysis . SYSEXEC LISTCSUM . SYSEXEC SYSUMON . SYSEXEC TRAPOUT Modification History 20020722 fxc NUMBERED on CLUSTER only; ignore NOWRITECHK, NOIMBED, NOREPLICAT, NOREUSE; 20020819 fxc rearranged parameters; drop obsolete tags 20030331 fxc no SUMMARY for a GDGBASE; a single generation of a GDG will show as NONVSAM with a 'GDG' tag in NONVSAMASSOCIATIONS; 20050207 fxc make sure output requires manual intervention; 20080410 fxc LISTCAT shows 'NONUNIQKEY' for AIX, but DEFINE wants 'NONUNIQUEKEY'; 20080722 fxc relabel BGG_DEFNVSAM to BGN_; 20160930 fxc an empty GDG BASE will have no NONVSAMASSOCIATIONS; parsing GDG will yield null 20211030 fxc LOG progress 20230401 fxc SYSUMON only if not testing 20230510 fxc save log if error or requested 20230723 fxc modernize logging; 20230810 fxc set msglim based on screen width; 20230824 fxc LISTCSUM was returning an empty queue; outdsn had LRECL=0; 20230908 fxc set log lrecl to 255; 20230917 fxc enable KEEP; 20231011 fxc correct syntax of DELETE; 20240308 fxc chg dollar-sign to @ everywhere; 20240415 fxc DUMP_QUEUE quiet; 20240529 fxc corrected DEFINE ALIAS for NONVSAM; */ arg argline address TSO /* REXXSKEL ver.20020513 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = Trace("O"); rc = trace(tv) info = parms /* to enable parsing */ call A_INIT /* -*/ call B_PROCESS_CAT /* -*/ if sw.0error_found + sw.0savelog > 0 then, call ZB_SAVELOG /* -*/ if \sw.0nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ VCX */ /* . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO if tv = 'N' then, /* only if not testing */ "SYSUMON USER" Userid() "TOOL" exec_name call AK_KEYWDS /* -*/ call AL_SETUP_LOG /* -*/ parse value "0 0 0 0 0 0 0 0 0 0" with , ct. . parse value "" with , taglist tagdata. , vwsuff , . parse var info dsname info return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ AK_KEYWDS: /*@ */ if branch then call BRANCH address TSO sw.0Skinny = SWITCH("SKINNY") outspec = KEYWD("OUTPUT") parse value outspec exec_name".SYSOUT" with, outdsn . if outspec <> '' then, parms = parms 'KEEP' if Pos( "(" , outdsn ) > 0 then, sw.0outpds = 1 /* output is partitioned */ return /*@ AK_KEYWDS */ /* . ----------------------------------------------------------------- */ AL_SETUP_LOG: /*@ */ if branch then call BRANCH address TSO msglim = SYSVAR( "SYSWTERM" ) - 12 parse value "0 0 0 0 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 "Arg:" argline ) return /*@ AL_SETUP_LOG */ /* Obtain definition data via LISTC; parse it into its components; recreate the DEFINE which produced this picture. . ----------------------------------------------------------------- */ B_PROCESS_CAT: /*@ */ if branch then call BRANCH address TSO "NEWSTACK" call BD_PULL_DATAPOINTS /* -*/ "DELSTACK" ; "NEWSTACK" if \sw.0error_found then, call BG_WRITE_DEFINE /* -*/ "DELSTACK" return /*@ B_PROCESS_CAT */ /* . ----------------------------------------------------------------- */ BD_PULL_DATAPOINTS: /*@ */ if branch then call BRANCH address TSO "LISTCSUM" dsname "STACK" /* -*/ logpref = "("Branch( "ID" )")" do queued() /* each queued line */ parse pull keytag ":" tagdata taglist = taglist keytag /* add to list */ tagdata.keytag = Strip( tagdata )/* load tagdata to keytag */ call ZL_LOGMSG( logpref keytag" : "tagdata.keytag ) end /* queued */ logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref "TagList : "taglist ) info = tagdata.SUMMARY parse value KEYWD("AIX") 0 with ct.0aix . parse value KEYWD("ALIAS") 0 with ct.0alias . parse value KEYWD("CLUSTER") 0 with ct.0cluster . parse value KEYWD("DATA") 0 with ct.0data . parse value KEYWD("PATH") 0 with ct.0path . parse value KEYWD("GDG") 0 with ct.0gdg . parse value KEYWD("INDEX") 0 with ct.0index . parse value KEYWD("NONVSAM") 0 with ct.0nonvsam . parse value KEYWD("TOTAL") 0 with ct.0total . ct.0subtot = ct.0alias + ct.0cluster + ct.0data + ct.0gdg + , ct.0aix + ct.0path + , ct.0index + ct.0nonvsam if ct.0total > ct.0subtot then do /* stuff we can't handle */ errmsg = exec_name "is not yet capable of handling something in", "this list:" info logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref errmsg ) if /monitor then, say errmsg sw.0error_found = 1 return /* we're done */ end if ct.0alias > 0 then call BDA_ALIAS /* -*/ if ct.0cluster > 0 then call BDC_CLU /* -*/ if ct.0gdg > 0 then call BDG_GDG /* -*/ if ct.0nonvsam > 0 then call BDN_NV /* -*/ if ct.0aix > 0 then call BDX_AIX /* -*/ return /*@ BD_PULL_DATAPOINTS */ /* An ALIAS is also referenced in NONVSAMASSOCIATIONS . ----------------------------------------------------------------- */ BDA_ALIAS: /*@ */ if branch then call BRANCH address TSO info = tagdata.dataassociations base = KEYWD("NONVSAM") alias = dsname alias = tagdata.alias logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "Base="base "Alias="alias ) return /*@ BDA_ALIAS */ /* CLUSTER. . ----------------------------------------------------------------- */ BDC_CLU: /*@ */ if branch then call BRANCH address TSO clusterdsn = tagdata.cluster info = tagdata.clusterassociations datadsn = KEYWD("DATA") indexdsn = KEYWD("INDEX") logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "DataDSN="datadsn "IndexDSN="indexdsn ) info = tagdata.clustersmsdata stgcls = KEYWD("STORAGECLASS") mgmtcls = KEYWD("MANAGEMENTCLASS") datacls = KEYWD("DATACLASS") call ZL_LOGMSG( logpref, "Stgcls="stgcls "Mgmtcls="mgmtcls "Datacls="datacls ) if ct.0data > 0 then, call BDCD_DATA /* -*/ if ct.0index > 0 then, call BDCI_INDEX /* -*/ return /*@ BDC_CLU */ /* CLUSTER DATA . ----------------------------------------------------------------- */ BDCD_DATA: /*@ */ if branch then call BRANCH address TSO info = tagdata.dataattributes keylen = KEYWD("KEYLEN") avgrecl = KEYWD("AVGLRECL") bufspc = KEYWD("BUFSPACE") cisize = KEYWD("CISIZE") rkp = KEYWD("RKP") maxrecl = KEYWD("MAXLRECL") excpext = KEYWD("EXCPEXIT") recsper = KEYWD("RECORDS/CI") maxrecs = KEYWD("MAXRECS") cicapct = KEYWD("CI/CA") shropts = CLKWD("SHROPTNS") /* CLIST-form */ dataopts = Space(info,1) /* whatever is left */ logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "Keylen="keylen "AvgRECL="avgrecl, "Bufspc="bufspc "CIsize="cisize "RKP="rkp, "Maxrecl="maxrecl "EXCPext="excpext, "Recsper="recsper "Maxrecs="maxrecs, "Cicapct="cicapct "Shropts="shropts, "Dataopts="dataopts, ) info = tagdata.dataallocation spctyp = KEYWD("SPACE TYPE") spcpri = KEYWD("SPACE PRI") spcsec = KEYWD("SPACE SEC") call ZL_LOGMSG( logpref, "Spctyp="spctyp "Spcpri="spcpri "Spcsec="spcsec, ) info = tagdata.datastatistics dfspcci = KEYWD("FREESPACE %CI") dfspcca = KEYWD("FREESPACE %CA") call ZL_LOGMSG( logpref, "DFspcci="dfspcci "DFspcca="dfspcca, ) info = tagdata.dataassociations clusterdsn = KEYWD("CLUSTER") call ZL_LOGMSG( logpref, "ClusterDSN="clusterdsn, ) return /*@ BDCD_DATA */ /* CLUSTER INDEX . ----------------------------------------------------------------- */ BDCI_INDEX: /*@ */ if branch then call BRANCH address TSO info = tagdata.indexattributes idxklen = KEYWD("KEYLEN") idxavgl = KEYWD("AVGLRECL") idxbuf = KEYWD("BUFSPACE") idxci = KEYWD("CISIZE") idxrkp = KEYWD("RKP") idxmaxl = KEYWD("MAXLRECL") idxecpx = KEYWD("EXCPEXIT") idxcica = KEYWD("CI/CA") idxshro = CLKWD("SHROPTNS") /* CLIST-form */ idxopts = Space(info,1) /* whatever is left */ logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref , "IDXklen="idxklen "IDXavgl="idxavgl, "IDXbuf="idxbuf "IDXci="idxci, "IDXrkp="idxrkp "IDXmaxl="idxmaxl, "IDXecpx="idxecpx "IDXcica="idxcica, "IDXshro="idxshro "IDXopts="idxopts, ) info = tagdata.indexallocation idxspc = KEYWD("SPACE TYPE") idxpri = KEYWD("SPACE PRI") idxsec = KEYWD("SPACE SEC") call ZL_LOGMSG( logpref , "IDXspc="idxspc "IDXpri="idxpri "IDXsec="idxsec, ) info = tagdata.indexstatistics xfspcci = KEYWD("FREESPACE %CI") xfspcca = KEYWD("FREESPACE %CA") call ZL_LOGMSG( logpref , "Xfspcci="xfspcci "Xfspcca="xfspcca, ) info = tagdata.indexassociations clusterdsn = KEYWD("CLUSTER") call ZL_LOGMSG( logpref , "ClusterDSN="clusterdsn, ) return /*@ BDCI_INDEX */ /* . Missing: OWNER, TO, FROM If the GDG BASE is empty, there will be no NONVSAMASSOCIATIONS from which to acquire the Base name. . ----------------------------------------------------------------- */ BDG_GDG: /*@ */ if branch then call BRANCH address TSO info = tagdata.gdgbaseattributes gdglim = KEYWD("LIMIT") info = tagdata.nonvsamassociations parse value KEYWD("GDG") dsname with dsname . gdgopts = Space(info,1) /* whatever is left */ logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "GDGlim="gdglim "GDGopts="gdgopts, ) ct.0nonvsam = 0 /* don't process NONVSAM */ return /*@ BDG_GDG */ /* NON-VSAM still undo: if a non-vsam file has an alias, DEFINE ALIAS . ----------------------------------------------------------------- */ BDN_NV: /*@ */ if branch then call BRANCH address TSO info = tagdata.nonvsamsmsdata stgcls = KEYWD("STORAGECLASS") mgmtcls = KEYWD("MANAGEMENTCLASS") datacls = KEYWD("DATACLASS") logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "Stgcls="stgcls "Mgmtcls="mgmtcls "Datacls="datacls, ) info = tagdata.nonvsamassociations nvalias = KEYWD("ALIAS") nvgdg = KEYWD("GDG") call ZL_LOGMSG( logpref, "NValias="nvalias "NVGDG="nvgdg, ) return /*@ BDN_NV */ /* AIX (alternate index) . ----------------------------------------------------------------- */ BDX_AIX: /*@ */ if branch then call BRANCH address TSO info = tagdata.aixassociations baseclname = KEYWD("CLUSTER") /* base clustername */ datadsn = KEYWD("DATA") /* data name */ indexdsn = KEYWD("INDEX") /* index name */ pathdsn = KEYWD("PATH") /* path name */ logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref, "BaseCLname="baseclname "DataDSN="datadsn, "IndexDSN="indexdsn "PathDSN="pathdsn, ) aixattrib = Space(tagdata.aixattributes,1) call ZL_LOGMSG( logpref, "AIXattrib="aixattrib, ) info = tagdata.dataassociations aixname = KEYWD("AIX") /* base AIX name */ call ZL_LOGMSG( logpref, "AIXname="aixname, ) info = tagdata.dataattributes keylen = KEYWD("KEYLEN") avgrecl = KEYWD("AVGLRECL") bufspc = KEYWD("BUFSPACE") cisize = KEYWD("CISIZE") rkp = KEYWD("RKP") maxrecl = KEYWD("MAXLRECL") axrkp = KEYWD("AXRKP") shropts = CLKWD("SHROPTNS") nunqkey = SWITCH("NONUNIQKEY") unqkey = SWITCH("UNIQKEY") + SWITCH("UNIQUEKEY") call ZL_LOGMSG( logpref, "Keylen="keylen "Avgrecl="avgrecl, "Bufspc="bufspc "CIsize="cisize, "RKP="rkp "Maxrecl="maxrecl "Axrkp="axrkp, "Shropts="shropts "Nunqkey="nunqkey, "Unqkey="unqkey, ) rc = Trace("O") @z = KEYWD( "EXCPEXIT" ) @z = KEYWD( "CI/CA" ) @z = SWITCH( "INDEXED" ) @z = SWITCH( "NOWRITECHK" ) @z = SWITCH( "WRITECHK" ) @z = SWITCH( "NOIMBED" ) @z = SWITCH( "IMBED" ) @z = SWITCH( "REPLICAT" ) @z = SWITCH( "NOREPLICAT" ) @z = SWITCH( "ORDERED" ) @z = SWITCH( "UNORDERED" ) @z = SWITCH( "NOREUSE" ) @z = SWITCH( "REUSE" ) @z = SWITCH( "SPANNED" ) rc = trace(tv) dataopts = Space(info,1) /* all remaining */ call ZL_LOGMSG( logpref, "Dataopts="dataopts, ) info = tagdata.datastatistics cipct = KEYWD("FREESPACE %CI") capct = KEYWD("FREESPACE %CA") call ZL_LOGMSG( logpref, "CIpct=" cipct "CApct="capct, ) info = tagdata.dataallocation spctyp = KEYWD("SPACE TYPE") spcpri = KEYWD("SPACE PRI") spcsec = KEYWD("SPACE SEC") call ZL_LOGMSG( logpref, "Spctyp="spctyp "Spcpri="spcpri "Spcsec="spcsec, ) info = tagdata.indexallocation idxspc = KEYWD("SPACE TYPE") idxpri = KEYWD("SPACE PRI") idxsec = KEYWD("SPACE SEC") call ZL_LOGMSG( logpref, "IDXspc="idxspc "IDXpri="idxpri "IDXsec="idxsec, ) info = tagdata.indexattributes idxklen = KEYWD("KEYLEN") idxavgl = KEYWD("AVGLRECL") idxbuf = KEYWD("BUFSPACE") idxci = KEYWD("CISIZE") idxrkp = KEYWD("RKP") idxmaxl = KEYWD("MAXLRECL") call ZL_LOGMSG( logpref, "IDXklen="idxklen "IDXavgl="idxavgl, "IDXbuf="idxbuf "IDXci="idxci, "IDXrkp="idxrkp "IDXmaxl="idxmaxl, ) pathopts = tagdata.pathattributes call ZL_LOGMSG( logpref, "Pathopts="pathopts, ) return /*@ BDX_AIX */ /* . ----------------------------------------------------------------- */ BG_WRITE_DEFINE: /*@ */ if branch then call BRANCH address TSO if ct.0alias > 0 then, call BGA_DEFALIAS /* -*/ if ct.0cluster > 0 then, call BGC_DEFCL /* -*/ if ct.0gdg > 0 then, call BGG_DEFGDG /* -*/ if ct.0nonvsam > 0 then, call BGN_DEFNVSAM /* -*/ if ct.0aix > 0 then, call BGX_DEFAIX /* -*/ call BGY_OUTPUT_DEFINE /* */ if sw.0BrowseTMP then do /* display text */ call BGZ_BROWSE_TMP /* -*/ "FREE FI(@TMP)" end /* BrowseTMP */ if WordPos( 'KEEP',parms ) = 0 then do msgstat = Msg( 'Off' ) "DELETE "outdsn rc = Msg( msgstat ) end return /*@ BG_WRITE_DEFINE */ /* . ----------------------------------------------------------------- */ BGA_DEFALIAS: /*@ */ if branch then call BRANCH address TSO queue " DEFINE ALIAS -" queue " ( NAME( -"alias" ) -" queue " RELATE( -"base" ) )" return /*@ BGA_DEFALIAS */ /* . ----------------------------------------------------------------- */ BGC_DEFCL: /*@ */ if branch then call BRANCH address TSO info = dataopts /* ready for parsing */ sw.numbered = SWITCH("NUMBERED") /* RRDS ? */ sw.indexed = SWITCH("INDEXED") /* KSDS ? */ sw.nonindx = SWITCH("NONINDEXED") /* ESDS ? */ sw.linear = SWITCH("LINEAR") /* Linear DS ? */ sw.reuse = SWITCH("REUSE") sw.noreuse = SWITCH("NOREUSE") if sw.reuse = sw.noreuse then, parse value "0 1" with sw.reuse sw.noreuse . sw.unique = SWITCH("UNIQUE") if sw.reuse then sw.unique = 0 @z = SWITCH( "NOWRITECHK" ) @z = SWITCH( "NOIMBED" ) @z = SWITCH( "NOREPLICAT" ) dataopts = Space(info,1) /* restore corrected */ queue " DELETE" "-"clusterdsn "CLUSTER" queue " " queue " SET MAXCC = 0" queue " " queue " DEFINE CLUSTER -" queue " ( NAME( -"clusterdsn" ) -" attribs = "" if sw.numbered then, attribs = attribs "NUMBERED" if sw.indexed then, attribs = attribs "INDEXED" if sw.nonindx then, attribs = attribs "NONINDEXED" if sw.linear then, attribs = attribs "LINEAR" if attribs <> "" then , queue " "Space(attribs,1)" -" if ct.0data > 0 then do if sw.0Skinny = 0 then do queue " ) -" queue " DATA -" queue " ( NAME( -"datadsn ") -" end /* skinny - drop this */ queue " "spctyp"(" spcpri "," spcsec ") -" queue " RECORDSIZE(" avgrecl "," maxrecl ") -" queue " FREESPACE(" dfspcci "," dfspcca ") -" if sw.reuse then dataopts = dataopts "REUSE" else dataopts = dataopts "NOREUSE" dataopts = Space(dataopts,1) do while dataopts <> "" pt = LastPos(" ",dataopts" ",40) slug = Substr(dataopts,1,pt) dataopts = Delstr(dataopts,1,pt) queue " "slug" -" end /* dataopts */ queue " BUFFERSPACE(" bufspc ") -" queue " SHAREOPTIONS(" shropts ") -" if keylen > 0 then, queue " KEYS(" keylen "," rkp ") -" end /* DATA */ if ct.0index > 0 then do if sw.0Skinny = 0 then do queue " ) -" queue " INDEX -" queue " ( NAME( -"indexdsn ") -" queue " "idxspc"(" idxpri "," idxsec ") -" info = idxopts /* ready for parsing */ rc = Trace("O") @z = SWITCH( "SPEED" ) @z = SWITCH( "RECOVERY" ) @z = SWITCH( "ERASE" ) @z = SWITCH( "NOERASE" ) @z = SWITCH( "UNIQUE" ) @z = SWITCH( "WRITECHK" ) @z = SWITCH( "NOWRITECHK" ) @z = SWITCH( "NOREPLICAT" ) @z = SWITCH( "REPLICAT" ) @z = SWITCH( "REPLICATE" ) rc = trace(tv) idxopts = Space(info,1) /* ready to load */ idxopts = Space(idxopts,1) do while idxopts <> "" pt = LastPos(" ",idxopts" ",40) slug = Substr(idxopts,1,pt) idxopts = Delstr(idxopts,1,pt) queue " "slug" -" end /* idxopts */ queue " SHAREOPTIONS(" idxshro ") -" end /* skinny - drop this */ end /* INDEX */ queue " )" queue " " queue " VERIFY DATASET( -"clusterdsn ")" return /*@ BGC_DEFCL */ /* . ----------------------------------------------------------------- */ BGG_DEFGDG: /*@ */ if branch then call BRANCH address TSO queue " DEFINE GENERATIONDATAGROUP -" queue " ( NAME( -"dsname ") -" queue " LIMIT(" gdglim ") -" queue " " gdgopts ")" return /*@ BGG_DEFGDG */ /* . ----------------------------------------------------------------- */ BGN_DEFNVSAM: /*@ */ if branch then call BRANCH address TSO nvbase = tagdata.nonvsam queue " DEFINE NONVSAM -" queue " ( NAME( -"nvbase ") )" if nvalias <> "" then do queue " DEFINE ALIAS ( -" queue " NAME( -"nvalias ") -" queue " RELATE( -"nvbase ") )" end /* nvalias */ return /*@ BGN_DEFNVSAM */ /* . ----------------------------------------------------------------- */ BGX_DEFAIX: /*@ */ if branch then call BRANCH address TSO queue " DELETE" "-"aixname " AIX" queue " " queue " SET MAXCC = 0" queue " " queue " DEFINE AIX -" queue " ( NAME( -"aixname ") -" queue " RELATE( -"baseclname ") -" queue " "aixattrib " -" if sw.0Skinny = 0 then do queue " ) -" queue " DATA -" queue " ( NAME( -"datadsn ") -" end /* skinny not */ queue " "spctyp"(" spcpri spcsec ") -" queue " RECORDSIZE(" avgrecl maxrecl ") -" if sw.0Skinny = 0 then do queue " FREESPACE(" cipct capct ") -" queue " BUFFERSPACE(" bufspc ") -" queue " SHAREOPTIONS(" shropts ") -" end /* skinny not */ queue " KEYS(" keylen "," rkp ") -" if sw.0Skinny = 0 then do if nunqkey then , queue " NONUNIQUEKEY -" else, queue " UNIQUEKEY -" /* Add dataattributes. This could be quite long */ do while dataopts <> "" pt = LastPos(" ",dataopts" ",40) /* ID 40 bytes */ slug = Substr(dataopts,1,pt) /* load to slug */ dataopts = Delstr(dataopts,1,pt) /* excise from dataopts */ queue " "slug" -" end /* dataopts */ queue " ) -" queue " INDEX -" queue " ( NAME( -"indexdsn ") -" queue " "idxspc"(" idxpri "," idxsec ") -" end /* skinny not */ queue " )" queue " " queue " DEFINE PATH -" queue " ( NAME( -"pathdsn ") -" queue " PATHENTRY( -"aixname ") -" queue " "pathopts " -" queue " )" queue " " queue " BLDINDEX -" queue " INDATASET( -"baseclname ") -" queue " OUTDATASET( -"aixname ")" queue " " queue " VERIFY DATASET( -"aixname ")" return /*@ BGX_DEFAIX */ /* Pump the queue to a dataset or the terminal . ----------------------------------------------------------------- */ BGY_OUTPUT_DEFINE: /*@ */ if branch then call BRANCH address TSO zz = Msg('OFF') "ALLOC FI(@TMP) NEW REU UNIT(VIO) SPACE(1) TRACKS RECFM(V B)", "LRECL(255) BLKSIZE(0)" if rc = 12 then alcunit = "SYSDA" else alcunit = "VIO" "FREE FI(@TMP)" zz = Msg(zz) alloc.0 = "NEW CATALOG UNIT(SYSDA) SPACE(1) TRACKS", "RECFM(V B) LRECL( 255 ) BLKSIZE(0)" vio.0 = "NEW CATALOG UNIT("alcunit") SPACE(1) TRACKS", "RECFM(V B) LRECL( 255 ) BLKSIZE(0)" alloc.1 = "SHR" /* if it already exists... */ if queued() = 0 then, queue " No data queued. " if outdsn <> "" then do /* write to DASD */ tempstat = Sysdsn(outdsn) = "OK",/* 1=exists, 0=missing */ | Sysdsn(outdsn) = "MEMBER NOT FOUND" "ALLOC FI(@TMP) DA( "outdsn" ) REU" alloc.tempstat "EXECIO" queued() "DISKW @TMP (FINIS" sw.0BrowseTMP = 1 /* */ end /* outdsn */ else , /* no OUTDSN */ if sw.inispf then do /* ISPF available */ "ALLOC FI(@TMP) REU" vio.0 "EXECIO" queued() "DISKW @TMP (FINIS" sw.0BrowseTMP = 1 /* */ end /* inispf */ else do /* write to terminal */ "CLEAR" /* */ do queued() pull line; say line /* */ end /* queued */ end /* terminal */ return /*@ BGY_OUTPUT_DEFINE */ /* . ----------------------------------------------------------------- */ BGZ_BROWSE_TMP: /*@ */ if branch then call BRANCH address ISPEXEC "CONTROL ERRORS RETURN" if sw.0outpds then do if Left(outdsn,1) = "'" then, /* quoted */ outdsn = Strip(outdsn,,"'") /* unquoted */ else outdsn = Userid()"."outdsn /* fully qualified */ parse var outdsn dsname "(" dsmbr ")" "LMINIT DATAID(DDNID) DATASET('"dsname"')" vwsuff = "MEMBER("dsmbr")" end /* sw.0outpds */ else, "LMINIT DATAID(DDNID) DDNAME(@TMP)" "EDIT DATAID("ddnid")" vwsuff return /*@ BGZ_BROWSE_TMP */ /* . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO if SWITCH("NONEST") then sw.0nested = 0 sw.0savelog = SWITCH( "LOG" ) return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ----------------------------------------------------------------- */ 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# msglim rc = Trace("O") address TSO parse arg msgtext /* for making the msgline always reasonably short: */ do while Length(msgtext) > msglim pt = LastPos(" ",msgtext,msglim) slug = Left(msgtext,pt) if monitor then say, slug parse value log#+1 slug with, zz log.zz 1 log# . msgtext = " "Substr(msgtext,pt) end /* while msglim */ parse value log#+1 msgtext with, zz log.zz 1 log# . if monitor then say, msgtext return /*@ ZL_LOGMSG */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg; say "" ex_nam = Left(exec_name,8) /* predictable size */ say " "ex_nam" generates pro-forma IDCAMS DEFINE statements for the " say " specified entity such as would have been used to " say " create it originally. " say " " say " Syntax: "ex_nam" dsname (Required)" say " OUTPUT outdsn (Defaults)" say " SKINNY " say " KEEP " say " (( LOG " say " " say " dsname identifies the entity to be analyzed so that (a) " say " DEFINE statement(s) can be constructed. " say " " say " outdsn names the target to receive the generated IDCAMS " say " DEFINE statements. If not specified, it defaults to" say " "exec_name".SYSOUT. " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " say " SKINNY (switch in parms) produces a shortened DEFINE which " say " names only the CLUSTER. " say " " say " KEEP (switch in parms) refers to . If OUTPUT or " say " KEEP is specified, is kept at process-end. " say " Otherwise, is is discarded. " say " " say " LOG (switch in opts) requests the log to be saved at " say " termination. Normally, the log is discarded unless " say " an error occurred. " say " " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " Debugging tools provided include: " 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 */ /* can be NAME or ID or null. . ----------------------------------------------------------------- */ 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 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 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 ssend . if ssend = "" then ssend = 10 if \datatype(ssbeg,"W") | \datatype(ssend,"W") then return ssend = ssbeg + ssend do ssii = ssbeg to ssend ; say Strip(sourceline(ssii),'T') ; end return /*@ SS */ /* . ----------------------------------------------------------------- */ SWITCH: Procedure expose info /*@ */ arg kw 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 SWITCH("TRAPOUT") then do "TRAPOUT" exec_name parms "(( TRACE R" info exit end /* trapout */ if Word(parms,1) = "?" then call HELP /* I won't be back */ "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 . sw.0nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = sysvar("SYSISPF") = "ACTIVE" 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 */