/* REXX MEMBERS Produce a concise member-list for a PO dataset. MEMBERS will return its output to the terminal (by default), or via the stack (option STACK) either as a vertical list (option LIST) or as a single line (option LINE). Use '(routine name) ?' for HELP-text. Written by Frank Clarke rexxhead@yahoo.com, 1989-03-28 Impact Analysis . SYSEXEC TRAPOUT Modification History 19991111 fxc upgrade from ver.19971030 to v.19991109; 20210408 fxc upgrade from v.19991109 to v.20210402 20230726 fxc adjust HELP; 20230729 fxc general clean-up; 20230806 fxc chg SYSPROC to SYSEXEC in Impact Analysis; 20240415 fxc DUMP_QUEUE quiet; */ arg argline address TSO /* REXXSKEL ver.20210402 */ arg parms "((" opts signal on syntax signal on novalue call TOOLKIT_INIT /* conventional start-up -*/ rc = trace(tv) info = parms /* to enable parsing */ if info = "" then call HELP /* -*/ call A_INIT /* -*/ if \sw.0error_found then, call B_LISTD /* -*/ if \sw.0error_found then, call C_BUILD /* -*/ if \sw.nested then call DUMP_QUEUE 'quiet' /* -*/ exit /*@ MEMBERS */ /* Initialization . ----------------------------------------------------------------- */ A_INIT: /*@ */ if branch then call BRANCH address TSO if tv = 'N' then, /* not testing */ if sw.0list + sw.0line <> 1 then, parse value "0 1" with sw.0list sw.0line parse var info dsname info parse value "0" with sw.0error_found . return /*@ A_INIT */ /* Develop memberlist and aliases, compacting the data so that all aliases for a member are on a single line. . ----------------------------------------------------------------- */ B_LISTD: /*@ */ if branch then call BRANCH address TSO trc = Outtrap("L.") "LISTD" dsname "M" trc = Outtrap("OFF") if l.0 < 7 then, if sw.0stack then queue "(EMPTY)" /* no members ! */ else do say "No members in" dsname exit end do ii = 1 to l.0 until Word(l.ii,1) = "--MEMBERS--" end /* Process the memberlist bottom-up. is formed of "anything accumulated so far" preceeded by the line above it. When the first 3 bytes of is blank, it's part of an aliaslist; keep it. When the first three bytes are NOT blank, a member name has been found; push the accumulated data onto the stack and reinitialize . */ slug = "" do bx = L.0 to ii+1 by -1 slug = L.bx Strip(slug) if Left(slug,3) <> "" then do; push slug; slug = ""; end end return /*@ B_LISTD */ /* The memberlist has been pushed onto the stack. . ----------------------------------------------------------------- */ C_BUILD: /*@ */ if branch then call BRANCH address TSO parse value 0 with , no_more_q stak . /* The phrase "THE FOLLOWING ALIAS NAMES EXIST WITHOUT TRUE NAMES" indicates aliases are in the PDS without true member names to match on. Skip this line and remaining lines in queue for member names Change add on 970820, BAB */ do queued() pull full_qline if no_more_q then iterate /* Clear the queue out */ if POS("THE FOLLOWING ALIAS NAMES",full_qline) > 0 then do no_more_q = 1 ; iterate end parse var full_qline mbr . "ALIAS(" aliaslist ")" call CA_STORE /* put the mbr on the list -*/ if ^sw.0alias then iterate /* skip all aliases */ if aliaslist <> "" then do aliaslist = Translate(aliaslist , " " , ",") do while aliaslist <> "" parse var aliaslist mbr aliaslist mbr = mbr"(*)" call CA_STORE /* -*/ end /* while aliaslist not blank */ end end if stak <> "" then, /* we loaded it */ if sw.0stack then, queue stak else, say stak return /*@ C_BUILD */ /* Given : and . ----------------------------------------------------------------- */ CA_STORE: /*@ */ if branch then call BRANCH address TSO if sw.0line then, /* LINE */ stak = stak mbr else, /* LIST vertically */ if sw.0stack then, /* sw.0list & sw.0stack */ queue mbr else, /* sw.0list & \sw.0stack */ say mbr return /*@ CA_STORE */ /* Parse non-canonical opts to the right of '((' . ----------------------------------------------------------------- */ LOCAL_PREINIT: /*@ customize opts */ if branch then call BRANCH address TSO sw.0alias = SWITCH("ALIAS") /* show aliases */ sw.0stack = SWITCH("STACK") /* return via the stack */ sw.0list = SWITCH("LIST") /* arrange in a vertical list */ sw.0line = SWITCH("LINE") /* arrange on one line */ return /*@ LOCAL_PREINIT */ /* subroutines below LOCAL_PREINIT are not selected by SHOWFLOW */ /* . ------------------------------------------------------------------*/ HELP: /*@ */ address TSO;"CLEAR" if helpmsg <> "" then say helpmsg ex_nam = Left(exec_name,8) /* predictable size */ say " " say " "ex_nam" Produces a concise member-list for a PO dataset. MEMBERS " say " will return its output to the terminal (by default), or " say " via the stack (option STACK) either as a vertical list " say " (option LIST) or as a single line (option LINE), " say " default=LINE. " say " " say " Syntax: "ex_nam" dsname " say " (( STACK " say " LIST " say " LINE " say " ALIAS " say " " say " ...more " "NEWSTACK"; pull; "CLEAR"; "DELSTACK" say " " say " STACK causes the resultant member list to be returned via " say " the stack. If STACK is not specified, return is to " say " the terminal. " say " " say " LIST causes the returned value(s) to be presented one " say " member per line (a vertical list). " say " " say " LINE causes the returned value(s) to be presented as a " say " single string containing all the members in order. " say " " say " ALIAS requests that alias entries also be returned. " say " MEMBERS ignores aliases by default. Alias entries " say " returned by MEMBERS will have '(*)' appended to the " say " aliasname. " "NEWSTACK"; pull; "CLEAR"; "DELSTACK" say " " say " Debugging tools provided include: " say " " say " BRANCH show all paragraph entries. " say " " say " TRACE tv will use value following TRACE to place the execution " say " in REXX TRACE Mode. " say " " say " " say " Debugging tools can be accessed in the following manner: " say " " say " TSO" exec_name" parameters (( debug-options " say " " say " For example " say " " say " TSO" exec_name " (( 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 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 */ sw.nested = sysvar("SYSNEST") = "YES" sw.batch = sysvar("SYSENV") = "BACK" sw.inispf = 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 */