/* REXX CBTXREF (v.2) Using table CBTSCAN, allow users to select members for display. Reconstruct DSNs from CBTAGS, ALLOC to file @TMP, and use KVW @TMP(cbmember) to display. Use '(routine name) ?' for HELP-text. |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| | | | WARNING: EMBEDDED COMPONENTS. | | See text following TOOLKIT_INIT | | | |**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**| Written by Frank Clarke rexxhead@yahoo.com 20230506 Impact Analysis . SYSEXEC DFLTTLIB . SYSEXEC FCCMDUPD . SYSEXEC KVW . SYSEXEC MEMLIST . SYSEXEC RUNDATA . SYSEXEC TRAPOUT Modification History 20230507 fxc adjust HELP; 20230517 fxc add LOCATE capability 20230519 fxc parametize VERSION and HLQ; adjust HELP; enable screen commands; added INSTALL option 20230525 fxc alloc_limit to prevent crashes 20230601 fxc enable SHOW primary command; enable MEMLIST line option; reorganize paragraphs; 20230803 fxc use hhmm for log file name; 20230809 fxc free @TMP along with LIBDEFs; add option 'A' to expand list of file tags; 20230810 fxc set msglim based on screen width; 20230811 fxc trim '(*)' from alias names before KVW; 20230827 fxc correct positioning after SHOW; 20230908 fxc set log lrecl to 255; 20230910 fxc use hitag from the admin row; 20230926 fxc use cretag from the admin row; 20231116 fxc add HELP prompt on panel; 20231208 fxc default to V506; 20240305 fxc align panel names; 20240308 fxc chg dollar-sign to @ everywhere; 20240410 fxc add TAGLIST processing; 20240415 fxc DUMP_QUEUE quiet; 20240506 fxc supply HLQ and LIMIT via RUNDATA; supply ISPTLIB via DFLTTLIB; */ arg argline address TSO /* REXXSKEL ver.20230501 */ 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 /* Initialization -*/ call T_TABLE_OPS /* Display members -*/ if sw.0error_found then, call ZB_SAVELOG /* -*/ if \sw.0nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ CBTXREF */ /* Initialization . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO call AL_SETUP_LOG /* -*/ parse value "" with, mbrs. mbrlist dsn. taglist tags. openmode. = "WRITE" openmode.1 = "NOWRITE" localvars = ' ztdtop hlq @tn@ zcmd verb text ', ' rdvsn taglist ' logpref = "("Branch( "ID" )")" "NEWSTACK" "RUNDATA READ TBLKEY CBTSCAN " /* sets IGNORE and RDVSN */ do queued() /* every line */ pull tag tagval tagval = Space( tagval,1 ) /* compress */ @z@ = Value( tag,tagval ) /* tag <- tagval */ call ZL_LOGMSG( logpref "Tag:" Left( tag,8 ) " Value:" tagval ) end /* queued */ "DELSTACK" hlq = hlq"."rdvsn /* CBT.V506 maybe? */ return /*@ A_INIT */ /* . ----------------------------------------------------------------- */ 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" tk_globalvars = tk_globalvars "log. log# msglim" logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref exec_name, "started by" Userid() yyyymmdd hhmmss ) call ZL_LOGMSG( logpref "Arg:" argline ) return /*@ AL_SETUP_LOG */ /* Build the table. The key is member and the data is the list of tags associated with that member. . ----------------------------------------------------------------- */ T_TABLE_OPS: /*@ */ if branch then call BRANCH address ISPEXEC call TC_OPEN /* -*/ call TS_SHOW_TBL /* -*/ call TZ_CLOSE /* -*/ return /*@ T_TABLE_OPS */ /* . ----------------------------------------------------------------- */ TC_OPEN: /*@ */ if branch then call BRANCH address ISPEXEC "LIBDEF ISPTLIB DATASET ID("isptlib") STACK" logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref "ISPTLIB set to" isptlib "for table" @tn@ ) "TBSTATS" @tn@ "STATUS1(s1) STATUS2(s2)" if s1 > 1 then do zerrsm = "Table" @tn@ "not available." zerrlm = "Table" @tn@ "not found in the ISPTLIB library chain" call ZL_LOGMSG( logpref zerrsm";" zerrlm) end; else, /* S1 */ if s2 = 1 then do /* table is not open */ "TBOPEN " @tn@ openmode.1 if rc > 4 then do sw.0error_found = 1 zerrsm = "Table did not OPEN" zerrlm = "Table" @tn@ "cannot be opened due to prior", "enqueues." call ZL_LOGMSG( logpref zerrsm";" zerrlm"; RC="rc) "SETMSG MSG(ISRZ002)" end else , call ZL_LOGMSG( logpref "Table" @tn@ "opened" openmode.1 ) end /* S2 */ else "TBTOP" @tn@ "LIBDEF ISPTLIB" return /*@ TC_OPEN */ /* . ----------------------------------------------------------------- */ TS_SHOW_TBL: /*@ */ if branch then call BRANCH address ISPEXEC call TSA_SETUP_LIBDEFS /* -*/ call TSB_GET_HITAG /* -*/ "TBTOP" @tn@ "TBVCLEAR" @tn@ /* zap values */ cbmember = '3f3f'x /* set to special */ "TBSARG" @tn@ "NAMECOND(CBMEMBER,GT)" /* exclude admin row */ sel = "" do forever "TBDISPL" @tn@ "PANEL( CBMBRS ) " if rc > 4 then leave if zcmd <> "" then do parse var zcmd verb text call TSC_COMMAND /* -*/ iterate end parse value "1" with sw.0limmsg zerrsm zerrlm do ztdsels "CONTROL DISPLAY SAVE" select when Pos( sel,"mM" ) > 0 then, call TSM_MEMBER_LIST /* -*/ when Pos( sel,"aA" ) > 0 then, call TSX_SHOW_TAGS /* -*/ otherwise, call TSD_DISPLAY_DSNS /* -*/ end /* select */ "CONTROL DISPLAY RESTORE" if ztdsels > 1 then "TBDISPL" @tn@ end /* ztdsels */ if zerrsm <> '' then do zerrsm = Strip( zerrsm ) zerrsm = Strip( zerrsm,"L",";" ) zerrlm = Strip( zerrlm ) zerrlm = Strip( zerrlm,"L",";" ) "SETMSG MSG( ISRZ002 )" end sel = "" end /* forever */ call TSZ_DROP_LIBDEFS /* -*/ return /*@ TS_SHOW_TBL */ /* . ----------------------------------------------------------------- */ TSA_SETUP_LIBDEFS: /*@ */ if branch then call BRANCH address ISPEXEC call DEIMBED /* unload ISPF assets -*/ dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist @ddn = @ddn.dd /* PLIB322 <- PLIB */ "LIBDEF ISP"dd "LIBRARY ID("@ddn") STACK" end ddnlist = ddnlist dd return /*@ TSA_SETUP_LIBDEFS */ /* Read the admin row (CBMEMBER = '3f3f'x) to set HITAG. . ----------------------------------------------------------------- */ TSB_GET_HITAG: /*@ */ if branch then call BRANCH address ISPEXEC cbmember = '3f3f'x /* less than blank */ "TBGET" @tn@ /* Set HITAG, CRETAG, TAGLIST */ logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref "HITAG set to" hitag ) return /*@ TSB_GET_HITAG */ /* Process 'zcmd' . ----------------------------------------------------------------- */ TSC_COMMAND: Procedure expose, /*@ */ (localvars) (tk_globalvars) if branch then call BRANCH address ISPEXEC if verb = "COUNTS" then, call TSCC_SORT_COUNT /* -*/ else, if verb = "LIBS" then, call TSCL_SHOWLIBS /* -*/ else, if Wordpos(Left(verb,1),"F L") > 0 then, call TSCF_FIND_ROW /* -*/ else, if verb = "RESET" then, call TSCR_REFRESH /* -*/ else, if verb = "SHOW" then, call TSCS_SHOW_FILE /* -*/ return /*@ TSC_COMMAND */ /* Sort CBCNT descending . ----------------------------------------------------------------- */ TSCC_SORT_COUNT: /*@ */ if branch then call BRANCH address ISPEXEC "TBSORT CBTSCAN FIELDS( CBCNT,N,D )" return /*@ TSCC_SORT_COUNT */ /* F(ind) or L(ocate) the member name. . ----------------------------------------------------------------- */ TSCF_FIND_ROW: /*@ */ if branch then call BRANCH address ISPEXEC "TBVCLEAR" @tn@ /* zap all variables */ @z@ = Value("CBMEMBER",text"*") /* load search value */ "TBSCAN" @tn@ "ARGLIST( CBMEMBER )",/* set ROWFND if successful */ "CONDLIST( GE ) ROWID(ROWFND) " if rc = 8 then do /* not found */ zerrsm = "Not found" zerrlm = "No rows found to match" text zerrlm = exec_name "("BRANCH("ID")")", zerrlm address ISPEXEC "SETMSG MSG(ISRZ002)" return end /* not found */ "TBSKIP" @tn@ "ROW("rowfnd") NOREAD" /* position to LASTFND */ return /*@ TSCF_FIND_ROW */ /* TAGLIST was found on the Admin row as an extension variable. TBCREATE table @TMP and write a new row for each file number in TAGLIST. Display a MEMLIST for any selected row. . ----------------------------------------------------------------- */ TSCL_SHOWLIBS: /*@ */ if branch then call BRANCH address ISPEXEC "TBCREATE @TMP KEYS( FNUM ) NOWRITE REPLACE " if rc > 4 then do zerrsm = "TBCREATE failed" zerrlm = "TBCREATE @TMP returned RC="rc "SETMSG MSG( ISRZ002 )" return end worklist = taglist do Words( worklist ) parse var worklist fnum worklist "TBADD @TMP" end /* worklist */ "TBTOP @TMP" sel = "" do forever "TBDISPL @TMP PANEL( FILES )" if rc > 4 then leave do ztdsels "CONTROL DISPLAY SAVE" if fnum < 1000 then fnum = Right( fnum,3 ) dsn = "'CBT."rdvsn".FILE"fnum".PDS'" if Sysdsn( dsn ) <> "OK" then do zerrsm = "Dataset not available." zerrlm = "DSN="dsn Sysdsn( dsn ) logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref zerrsm";" zerrlm) "SETMSG MSG(ISRZ002)" return end /* DSN not OK */ address TSO "MEMLIST" dsn /* -*/ "CONTROL DISPLAY RESTORE" if ztdsels > 1 then "TBDISPL @TMP" end /* ztdsels */ sel = "" end /* forever */ return /*@ TSCL_SHOWLIBS */ /* Restore default display . ----------------------------------------------------------------- */ TSCR_REFRESH: /*@ */ if branch then call BRANCH address ISPEXEC "TBSORT CBTSCAN FIELDS( CBMEMBER,C,A )" return /*@ TSCR_REFRESH */ /* Primary command SHOW 149 asks that the entire 149 file be presented. Variable 'text' conatins the file number. . ----------------------------------------------------------------- */ TSCS_SHOW_FILE: /*@ */ if branch then call BRANCH address ISPEXEC toprow = ztdtop parse var text tag . if tag < 1000 then, /* 0566 maybe */ tag = Right( '000'tag,3 ) /* 566 */ dsn = "'"hlq".FILE"tag".PDS'" if Sysdsn( dsn ) <> "OK" then do sw.0error_found = 1 zerrsm = "Dataset not available." zerrlm = "DSN="dsn Sysdsn( dsn ) logpref = "("Branch( "ID" )")" call ZL_LOGMSG( logpref zerrsm";" zerrlm) "SETMSG MSG(ISRZ002)" return end /* DSN not OK */ address TSO "MEMLIST" dsn /* -*/ "TBTOP" @tn@ /* reposition to current top */ "TBSKIP" @tn@ "NUMBER( &toprow )" return /*@ TSCS_SHOW_FILE */ /* The user selected this row. Regenerate all the dsns from the tags, ALLOC those DSNs to file @TMP, then KVW @TMP(cbmember). If too many involved DSNs, flush the request. . ----------------------------------------------------------------- */ TSD_DISPLAY_DSNS: /*@ */ if branch then call BRANCH address TSO parse value "" with dsnlist missing if Words( cbtags ) > alloc_limit then do /* too many */ zerrsm = zerrsm ";" "Too many DSNs" zerrlm = zerrlm ";" "Restricted from displaying", Words( cbtags ) "datasets." if sw.0limmsg then do /* show limit */ sw.0limmsg = 0 /* only once */ zerrlm = zerrlm "Limit is" alloc_limit end /* limmsg */ return end /* alloc_limit */ do Words( cbtags ) /* each tag for this member */ parse var cbtags tag cbtags if tag < 1000 then, /* 0566 maybe */ tag = Right( tag,3 ) /* 566 */ dsn = "'"hlq".FILE"tag".PDS'" if Sysdsn( dsn ) = "OK" then, dsnlist = dsnlist dsn /* add it */ else, /* not OK... */ missing = missing dsn /* add it */ end /* cbtags */ if missing <> "" then do /* some are missing */ zerrsm = zerrsm ";" "Missing data" zerrlm = zerrlm ";" "The following datasets were not found:", missing end parse var cbmember cbmember "(" "ALLOC FI(@TMP) DA(" dsnlist ") SHR REU" "KVW @TMP("cbmember")" "(( TRACE" tv return /*@ TSD_DISPLAY_DSNS */ /* A member list of the entire file has been requested. CBCNT must be '1'. This can't be invoked for lines with more than one file involved. Build the filename and provoke VIEW. . ----------------------------------------------------------------- */ TSM_MEMBER_LIST: /*@ */ if branch then call BRANCH address ISPEXEC if cbcnt > 1 then do /* reject */ zerrsm = "Rejected" zerrlm = "A member list cannot be produced for lines", "involving more than one file-id. Use primary", "command 'SHOW' instead." "SETMSG MSG(ISRZ002)" return end /* cbcnt */ parse var cbtags tag cbtags if tag < 1000 then, /* 0566 maybe */ tag = Right( tag,3 ) /* 566 */ dsn = "'"hlq".FILE"tag".PDS'" address TSO "MEMLIST" dsn /* -*/ return /*@ TSM_MEMBER_LIST */ /* Show all the tags in a scrollable list. TBCREATE table TAGS. TBADD each element of . At end, TBEND to avoid saving. . ----------------------------------------------------------------- */ TSX_SHOW_TAGS: /*@ */ if branch then call BRANCH address ISPEXEC "TBCREATE TAGS KEYS( TAG ) WRITE REPLACE " do Words( cbtags ) /* each tag */ parse var cbtags tag cbtags /* isolate */ "TBADD TAGS " end /* cbtags */ "TBTOP TAGS " sel = "" tagmbr = cbmember /* */ do forever "TBDISPL TAGS PANEL( ALLTAGS )" if rc > 4 then leave do ztdsels "CONTROL DISPLAY SAVE" if tag < 1000 then, /* 0566 maybe */ tag = Right( tag,3 ) /* 566 */ dsn = "'"hlq".FILE"tag".PDS("tagmbr")'" "VIEW DATASET( "dsn" ) " "CONTROL DISPLAY RESTORE" if ztdsels > 1 then "TBDISPL TAGS " end /* ztdsels */ sel = "" end /* forever */ "TBEND TAGS " return /*@ TSX_SHOW_TAGS */ /* . ----------------------------------------------------------------- */ TSZ_DROP_LIBDEFS: /*@ */ if branch then call BRANCH address ISPEXEC dd = "" do Words(ddnlist) /* each LIBDEF DD */ parse value ddnlist dd with dd ddnlist @ddn = @ddn.dd /* PLIB322 <- PLIB */ "LIBDEF ISP"dd address TSO "FREE FI("@ddn")" end ddnlist = ddnlist dd @msg = MSG( 'OFF' ) address TSO "FREE FI( @TMP )" @msg = MSG( @msg ) return /*@ TSZ_DROP_LIBDEFS */ /* . ----------------------------------------------------------------- */ TZ_CLOSE: /*@ */ if branch then call BRANCH address ISPEXEC "TBEND " @tn@ return /*@ TZ_CLOSE */ /* The RUNDATA table should supply: HLQ the default high-level-qualifier for CBT datasets, LIMIT the maximum # of libraries shown for a single request. . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ address TSO if SWITCH("INSTALL") then do /* set tmpcmds */ queue "XREF" /* zctverb */ queue "0" /* zcttrunc */ queue "SELECT CMD(%CBTXREF &ZPARM)" /* zctact */ queue "View CBTSCAN table" /* zctdesc */ "FCCMDUPD" /* load the table */ exit end /* INSTALL */ isptlib = "'"DFLTTLIB( 'CBTSCAN' )"'" "NEWSTACK" "RUNDATA READ TBLKEY CBTXREF " /* sets HLQ and LIMIT */ do queued() pull tag tagval tagval = Space( tagval,1 ) /* compress */ @z@ = Value( tag,tagval ) /* tag <- tagval */ end /* queued */ "DELSTACK" if Symbol( "HLQ" ) = "LIT" |, Symbol( "LIMIT" ) = "LIT" then do /* not yet set */ address ISPEXEC zerrsm = "RUNDATA error" zerrlm = "The RUNDATA table did not return a value for HLQ or", "LIMIT in TBLKEY=CBTXREF. ", "See installation instructions for more information." "SETMSG MSG( ISRZ002) " exit end alloc_limit = limit parse value KEYWD( "USETBL" ) "CBTSCAN" with, @tn@ . 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 */ /* Parse out the embedded components at the back of the source code. . ----------------------------------------------------------------- */ DEIMBED: Procedure expose, /*@ */ (tk_globalvars) ddnlist @ddn. daid. address TSO fb80po.0 = "NEW DELETE REU UNIT(SYSDA) SPACE(1 5) TRACKS DIR(40)", "RECFM(F B) LRECL(80) BLKSIZE(0)" fb80po.1 = "SHR REU" parse value "" with ddnlist @ddn. daid. lastln = sourceline() currln = lastln /* */ if Left(sourceline(currln),2) <> "*/" then return currln = currln - 1 /* previous line */ "NEWSTACK" address ISPEXEC do while sourceline(currln) <> "/*" text = sourceline(currln) /* save with a short name ! */ if Left(text,3) = ")))" then do /* package the queue */ parse var text ")))" ddn mbr . /* PLIB PANL001 maybe */ if length(ddn) > 4 then do /* data, not ISPF */ call DESPOOL /* -*/ currln = currln - 1 /* previous line */ iterate end if Pos(ddn,ddnlist) = 0 then do /* doesn't exist */ ddnlist = ddnlist ddn /* keep track */ @ddn = ddn || Random(999) /* PLIB322 maybe */ @ddn.ddn = @ddn /* @ddn.PLIB = PLIB322 */ address TSO "ALLOC FI("@ddn")" fb80po.0 "LMINIT DATAID(DAID) DDNAME("@ddn")" daid.ddn = daid end daid = daid.ddn "LMOPEN DATAID("daid") OPTION(OUTPUT)" do queued() parse pull line "LMPUT DATAID("daid") MODE(INVAR) DATALOC(LINE) DATALEN(80)" end "LMMADD DATAID("daid") MEMBER("mbr")" "LMCLOSE DATAID("daid")" end /* package the queue */ else push text /* onto the top of the stack */ currln = currln - 1 /* previous line */ end /* while */ address TSO "DELSTACK" return /* Subroutine of DEIMBED for non-ISPF data. Given : the stack, ddn, and mbr . ----------------------------------------------------------------- */ DESPOOL: /*@ */ if branch then call BRANCH address TSO if WordPos( ddn,ddnlist ) = 0 then, ddnlist = Space( ddnlist ddn,1 ) if Sysdsn(ddn".DATA") <> "OK" then, "ALLOC FI("ddn") DA("ddn".DATA)" fb80po.0 "ALLOC FI("ddn") DA("ddn".DATA("mbr")) SHR REU" "EXECIO" queued() "DISKW" ddn "(FINIS" "DELSTACK" "NEWSTACK" /* re-establish */ return /*@ DESPOOL */ return /*@ DEIMBED */ /* . ----------------------------------------------------------------- */ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" (v.2) displays the CBT cross-reference table, CBTSCAN. " say " " say " Syntax: "ex_nam" no parms " say " (( USETBL tblname (Defaults)" say " " say " tblname identifies the table to be displayed. If not " say " specified, it defaults to 'CBTSCAN', the value set " say " in LOCAL_PREINIT. " "NEWSTACK"; pull ; "CLEAR" ; "DELSTACK" say " " 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 execution " say " into 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 sw.0inispf 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 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")", info if wordpos(dlm,back) = 0 then /* search for ending delimiter*/ helpmsg = helpmsg, "No matching second delimiter("dlm") with KEYPHRS("kp")", info 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 */ sw.0nested = sysvar("SYSNEST") = "YES" sw.0batch = sysvar("SYSENV") = "BACK" sw.0inispf = sysvar("SYSISPF") = "ACTIVE" 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 . 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 */ /* ))) PLIB CBMBRS Members with file tags )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) # TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) JUST( RIGHT ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %|-| CBT Member Cross-reference +|-| %Command ===>_ZCMD %Scroll ===>_ZAMT+ %PF1 for HELP +V Member Count Filetags------ Latest File !hitag+(@cretag +) )MODEL ROWS( SCAN ) _z!cbmember #cbcnt+ @cbtags )INIT .ZVARS = '(SEL)' .HELP = CBMBRSH )REINIT )PROC IF (.PFKEY = 'PF05') &PFKEY = 'F5' .RESP = END )END ))) PLIB CBMBRSH Help for CBMBRS )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) } AREA( SCRL ) EXTEND( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %TUTORIAL |-| CBT Member Cross-reference |-| TUTORIAL %Next Selection ===>_ZCMD + }hlptxt } )AREA HLPTXT + For each shown member, the CBT file numbers are shown following, and the + number of files associated with the member. + + Select any member with any character (%except 'A' or 'M'+) to see a + selectable list of the files containing this member (if there are more than + one file). If there is only one file associated, VIEW the source directly. + + Select any member with%'A'+to see a selectable list of all the associated + file numbers, even the ones not displayed because of the screen limits. + + Select any member (if the file-count is '1') with%'M'+to see the entire file + (all members). + + Primary commands%'L', 'F', 'COUNTS', 'LIBS', 'RESET',+and%'SHOW'+are + supported. + + Command%'L'+or%'F'+with a member name (may be partial) to be positioned to + that portion of the table: +% ===> l text + + Command%'COUNTS'+to see the table sorted in decsending order by Count. +% ===> counts + + Command%'LIBS'+to see a selectable list of all the files that went into + making up the complete CBTSCAN table. If your installation has not + downloaded the complete set of CBT files, some of these will deliver a + 'Dataset not found' when selected. +% ===> libs + + Command%'RESET'+to restore the display to its default state. +% ===> reset + + Command%'SHOW file#'+to obtain a full memberlist of the designated file. +% ===> SHOW 149 + + )PROC &ZUP = CBMBRSH &ZCONT = CBMBRSH )END ))) PLIB FILES Show File numbers )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) )BODY EXPAND(||) %|-| Available files +|-| %Command ===>_ZCMD %Scroll ===>_ZAMT+ + File Number %PF1 for HELP )MODEL _z!fnum + )INIT .ZVARS = '(SEL)' .HELP = FILESH )REINIT )PROC IF (.PFKEY = 'PF05') &PFKEY = 'F5' .RESP = END )END ))) PLIB FILESH HELP for Panel FILES )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) } AREA( SCRL ) EXTEND( ON ) )BODY EXPAND(||) %TUTORIAL |-| Available files |-| TUTORIAL %Next Selection ===>_ZCMD + }hlptxt } )AREA HLPTXT + + All available files are shown in a selectable/scrollable list. + + Select any row to see the memberlist for that CBT file. + )PROC &ZUP = FILESH &ZCONT = FILESH )END ))) PLIB ALLTAGS Display all elements of CBTAGS )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ~ TYPE( INPUT ) INTENS( HIGH ) CAPS( ON ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %|-| All File Tags +|-| %Command ===>_ZCMD %Scroll ===>_ZAMT+ %PF1 for HELP +V File Number for member!tagmbr )MODEL ~z+ !tag + )INIT .ZVARS = '(SEL)' .HELP = ALLTAGSH )REINIT )PROC IF (.PFKEY = 'PF05') &PFKEY = 'F5' .RESP = END )END ))) PLIB ALLTAGSH Help for ALLTAGS )ATTR % TYPE( TEXT ) INTENS( HIGH ) SKIP( ON ) + TYPE( TEXT ) INTENS( LOW ) SKIP( ON ) _ TYPE( INPUT ) INTENS( HIGH ) ! TYPE( OUTPUT ) INTENS( HIGH ) SKIP( ON ) @ TYPE( OUTPUT ) INTENS( LOW ) SKIP( ON ) )BODY EXPAND(||) WIDTH(&ZSCREENW) %TUTORIAL |-| All File Tags |-| TUTORIAL %Next Selection ===>_ZCMD + + Select any file number with any character to VIEW the associated member. + )PROC &ZUP = ALLTAGSH &ZCONT = ALLTAGSH )END */