/* REXX - */ /* */ /* AUTHOR: Mark Zelden */ /* */ /* Indirect storage addressing code */ /* contribution from: Mau Tran */ /* */ /* */ help_start = HELP_INCL() /*********************************************************************/ /* DISPLAY MEMORY IN "DUMP" FORMAT */ /*********************************************************************/ /* EXECUTION SYNTAX: */ /* */ /* TSO %REXXMEM */ /* */ /* The strt_addr and length values are expected to be hexidecimal. */ /* The hexadecimal values supplied may be represented with or */ /* without an "X". In other words, x'100' and 100 can both be */ /* processed and are treated the same. */ /* */ /* strt_addr can also make use of indirect storage addressing */ /* similar to IPCS. "?", "%", "+", "-" and "." are supported. */ /* See the examples below. */ /* */ /* NOTE #1: If no length is specified, then the default is 100 (hex).*/ /* */ /* NOTE #2: While "." is supported like IPCS, it is not required */ /* when the initial digit is the letter A through F like */ /* it is in IPCS and is essentially ignored. */ /* */ /* NOTE #3: If any storage in the range is protected, then none of */ /* it can be displayed. This is how the REXX STORAGE */ /* function works. */ /* */ /* NOTE #4: If you execute REXXMEM without a parm or a parm of "?" */ /* the comment section of this code with syntax and usage */ /* notes plus examples will be displayed as "help". */ /* */ /* NOTE #5: In z/OS 2.1 and above strt_addr can be a 64-bit */ /* address. The address specifcation rules are the */ /* same as those documented in the TSO/E REXX reference */ /* manual for the STORAGE TSO/E External Function. */ /* */ /*********************************************************************/ /* */ /* Examples: */ /* TSO %REXXMEM (display syntax, notes & examples) */ /* TSO %REXXMEM 0 (start at x'00000000' for x'100') */ /* TSO %REXXMEM 10 100 (start at x'00000010' for x'100') */ /* TSO %REXXMEM x'10' x'100' (start at x'00000010' for x'100') */ /* TSO %REXXMEM FD0740 (start at x'00FD0740' for x'100') */ /* TSO %REXXMEM FD0746 64 (start at x'00FD0746' for x'64') */ /* TSO %REXXMEM 4C% (24-bit ptr to stor at x'4C') */ /* TSO %REXXMEM 10.%% (24-bit ptr x'10' + 2nd 24-bit ptr) */ /* TSO %REXXMEM 10? (31-bit ptr to stor at x'10' - CVT) */ /* TSO %REXXMEM 10?+8C? 200 (point to ECVT stor for x'200') */ /* TSO %REXXMEM 10?+22C? 1E00 (point to ASVT stor for x'1E00') */ /* TSO %REXXMEM 10?+8C?+188? 1000 (point to IPA for x'1000') */ /* TSO %REXXMEM 1FFFFF00000 (64-bit address display) */ /* TSO %REXXMEM 1FF_FFF00000 200 (64-bit display for x'200') */ /* */ /*********************************************************************/ help_end = HELP_INCL() /*********************************************************************/ LASTUPD = '01/29/2015' /* date of last update */ /*********************************************************************/ Arg R_ADDR R_LEN HELPDSP = 0 /* default panel display */ Numeric digits 20 /* dflt of 9 not enough */ If R_ADDR = '' | R_ADDR = '?' then do /* call help routine */ R_ADDR = 0 R_LEN = 0 HELPDSP = 1 /* help panel display */ Call HELP_DISPLAY Call FINISHED End /* tokenize strt_addr parm */ /*********************************************************************/ Signal On Syntax /* error condition */ If R_ADDR = '' then R_ADDR = 0 /* dflt strt_addr 00000000 */ If R_LEN = '' then R_LEN = 100 /* dflt length x'100' */ R_ADDR = Translate(R_ADDR,"","xX'") /* remove hex notation */ R_ADDR = Space(R_ADDR,0) /* rmv blnks in addr string*/ R_LEN = Translate(R_LEN ,"","xX'") /* remove hex notation */ R_LEN = Strip(R_LEN) /* remove blanks */ If Length(R_ADDR) > 8 then do /* 64-bit address? */ R_ADDR = Translate(R_ADDR,"","_") /* remove underscore */ R_ADDR = Space(R_ADDR,0) /* rmv blnks in addr string*/ End /*********************************************************************/ /* Tokenize the input address string for indirect addressing */ /*********************************************************************/ Call TOKENIZE R_ADDR R_ADDR = TOKEN.1 /*********************************************************************/ R_ADDR = X2d(R_ADDR) /* change to dec for rexx */ R_LEN = X2d(R_LEN) /* change to dec for rexx */ R_ADDR = RESOLVE_ADDR(R_ADDR) /*********************************************************************/ /* Try and get the storage requested */ /*********************************************************************/ D_STOR = Storage(D2x(R_ADDR),R_LEN) /* get the storage */ If D_STOR = '' then do /* none returned? */ Say 'Some storage in specified range is protected - none' , 'can be displayed.' "Delstack" /* delete data stack */ Exit 12 End D_STORX = C2x(D_STOR) D_STORL = Length(D_STORX) /*********************************************************************/ /* Routine to format address fro the output display and for the */ /* ISPF long help message */ /*********************************************************************/ M_ADDR = D2x(R_ADDR) R_ADDR_L = Length(M_ADDR) If R_ADDR_L > 8 then do M_ADDR1 = Substr(M_ADDR,1,R_ADDR_L-8) M_ADDR1 = Right(M_ADDR1,8,'0') M_ADDR2 = Right(M_ADDR,8) M_ADDR = M_ADDR1 || '_' || M_ADDR2 End Else , M_ADDR = Right(M_ADDR,8,'0') Queue 'STORAGE(' || M_ADDR || ',' || D2x(R_LEN) || ')' Queue ' ' /*********************************************************************/ /* Routine to make sure we start the storage display at an address */ /* that is on a quadruple word boundry. */ /*********************************************************************/ If (R_ADDR/16) <> 0 then do T1 = Trunc(R_ADDR/16) T2 = T1 * 16 DIFF_S = R_ADDR - T2 D_ADDR = R_ADDR - DIFF_S D_STORX = Copies('40',DIFF_S) || D_STORX /* add blanks */ D_STORL = Length(D_STORX) End Else D_ADDR = R_ADDR /*********************************************************************/ /* Routine to format storage address and length from above */ /*********************************************************************/ D_OFF = 0 /* relative offset */ Queue 'Address Offset 0-1-2-3- 4-5-6-7- 8-9-A-B- C-D-E-F-' , ' 0123456789ABCDEF' Do I = 1 to D_STORL by 32 D_ADDR = Right(D2x(D_ADDR),8,0) /* format stg addr */ D_OFF2 = Right('+'|| D2x(D_OFF),6,' ') /* format offset */ D_STOR_A = Strip(Substr(D_STORX,I,32)) /* remove blanks */ If I > D_STORL - 32 then do /* last time only */ DIFF_L = (31-(D_STORL-I)) / 2 /* figure out how many blanks */ ENDBLNKS = Copies(' ',DIFF_L) /* to add at end of ebcdic */ D_STOR_E = X2c(D_STOR_A) || ENDBLNKS /* make EBCDIC */ End Else D_STOR_E = X2c(D_STOR_A) /* make EBCDIC */ If I = 1 & R_ADDR <> 0 then /* fix hex display */ D_STORX = Overlay(' ',D_STORX,1,DIFF_S*2, ' ') /* for start addr */ D_STORX1 = Substr(D_STORX,I,8) /* first word */ D_STORX2 = Substr(D_STORX,I+8,8) /* second word */ D_STORX3 = Substr(D_STORX,I+16,8) /* third word */ D_STORX4 = Substr(D_STORX,I+24,8) /* forth word */ If R_ADDR <= 2147483648 then , /* 31-bit address */ Queue D_ADDR '' D_OFF2 '' D_STORX1 '' D_STORX2 '' D_STORX3 , '' D_STORX4 ' |' D_STOR_E '|' Else do D_ADDR2 = Overlay('_',D_ADDR,1) /* 64-bit address */ Queue D_ADDR2 '' D_OFF2 '' D_STORX1 '' D_STORX2 '' D_STORX3 , '' D_STORX4 ' |' D_STOR_E '|' End D_ADDR = X2d(D_ADDR) + 16 /* bump up addr */ If I = 1 & R_ADDR <> 0 then D_OFF = 16-DIFF_S /* bump up offset */ Else D_OFF = D_OFF + 16 /* bump up offset */ End Queue '' /* NULL Queue TO END STACK */ /***************************************************************/ FINISHED: If Sysvar(SYSISPF) = 'ACTIVE' then call BROWSE_ISPF Else do Queued() Parse pull line Say line End Exit 0 /***************************************************************/ BROWSE_ISPF: Queue '' /* null queue to end stack */ Address ISPEXEC "CONTROL ERRORS RETURN" Address ISPEXEC "VGET ZENVIR" Address TSO prefix = sysvar('SYSPREF') /* tso profile prefix */ uid = sysvar('SYSUID') /* tso userid */ If prefix = '' then prefix = uid /* use uid if null prefix */ If prefix <> '' & prefix <> uid then /* different prefix than uid */ prefix = prefix || '.' || uid /* use prefix.uid */ ddnm1 = 'DD'||random(1,99999) /* choose random ddname */ ddnm2 = 'DD'||random(1,99999) /* choose random ddname */ junk = msg(off) "ALLOC FILE("||ddnm1||") UNIT(SYSALLDA) NEW TRACKS SPACE(9,9) DELETE", " REUSE LRECL(80) RECFM(F B) BLKSIZE(3120)" "ALLOC FILE("||ddnm2||") UNIT(SYSALLDA) NEW TRACKS SPACE(1,1) DELETE", " REUSE LRECL(80) RECFM(F B) BLKSIZE(3120) DIR(1)", " DA('"||prefix||".REXXMEM." ||ddnm2|| ".ISPPLIB')" junk = msg(on) Newstack /*************************/ /* REXXMEMP Panel source */ /*************************/ If Substr(ZENVIR,6,1) >= 4 then Queue ")PANEL KEYLIST(ISRSPBC,ISR)" Queue ")ATTR" Queue " _ TYPE(INPUT) INTENS(HIGH) COLOR(TURQ) CAPS(OFF)" , "FORMAT(&MIXED)" Queue " | AREA(DYNAMIC) EXTEND(ON) SCROLL(ON)" Queue " + TYPE(TEXT) INTENS(LOW) COLOR(BLUE)" Queue " @ TYPE(TEXT) INTENS(LOW) COLOR(TURQ)" Queue " % TYPE(TEXT) INTENS(HIGH) COLOR(GREEN)" Queue " ! TYPE(OUTPUT) INTENS(HIGH) COLOR(TURQ) PAD(-)" Queue " 01 TYPE(DATAOUT) INTENS(LOW)" Queue " 02 TYPE(DATAOUT) INTENS(HIGH)" Queue " 0B TYPE(DATAOUT) INTENS(HIGH) FORMAT(DBCS)" Queue " 0C TYPE(DATAOUT) INTENS(HIGH) FORMAT(EBCDIC)" Queue " 0D TYPE(DATAOUT) INTENS(HIGH) FORMAT(&MIXED)" Queue " 10 TYPE(DATAOUT) INTENS(LOW) FORMAT(DBCS)" Queue " 11 TYPE(DATAOUT) INTENS(LOW) FORMAT(EBCDIC)" Queue " 12 TYPE(DATAOUT) INTENS(LOW) FORMAT(&MIXED)" Queue ")BODY EXPAND(//)" Queue "%BROWSE @&ZTITLE / / %Line!ZLINES %Col!ZCOLUMS+" Queue "%Command ===>_ZCMD / / %Scroll ===>_Z +" Queue "|ZDATA ---------------/ /-------------------------|" Queue "| / / |" Queue "| --------------------/-/-------------------------|" Queue ")INIT" Queue " .HELP = ISR10000" Queue " .ZVARS = 'ZSCBR'" If HELPDSP = 1 then , Queue " &ZTITLE = 'Mark''s MVS Utilities - REXXMEM -- HELP --'" Else , Queue " &ZTITLE = 'Mark''s MVS Utilities - REXXMEM'" Queue " &MIXED = MIX" Queue " IF (&ZPDMIX = N)" Queue " &MIXED = EBCDIC" Queue " VGET (ZSCBR) PROFILE" Queue " IF (&ZSCBR = ' ')" Queue " &ZSCBR = 'CSR'" Queue ")REINIT" Queue " REFRESH(ZCMD,ZSCBR,ZDATA,ZLINES,ZCOLUMS)" Queue ")PROC" Queue " &ZCURSOR = .CURSOR" Queue " &ZCSROFF = .CSRPOS" Queue " &ZLVLINE = LVLINE(ZDATA)" Queue " VPUT (ZSCBR) PROFILE" Queue ")END" Queue "" /* */ "ALLOC FILE(REXXMEMP) SHR REUSE", " DA('"||prefix||".REXXMEM." ||ddnm2|| ".ISPPLIB(REXXMEMP)')" "EXECIO * DISKW REXXMEMP (FINIS" "FREE FI(REXXMEMP)" Delstack "EXECIO * DISKW" ddnm1 "(FINIS" If HELPDSP = 1 then zedsmsg = 'Help displayed' Else zedsmsg = 'Storage displayed' zedlmsg = 'REXXMEM - Last updated on' , LASTUPD ||'. Written by' , 'Mark Zelden. Mark''s MVS Utilities -' , 'http://www.mzelden.com/mvsutil.html' Address ISPEXEC "LIBDEF ISPPLIB LIBRARY ID("ddnm2") STACK" Address ISPEXEC "SETMSG MSG(ISRZ000)" /* msg - no alarm */ Address ISPEXEC "LMINIT DATAID(TEMP) DDNAME("ddnm1")" Address ISPEXEC "BROWSE DATAID("temp") PANEL(REXXMEMP)" Address ISPEXEC "LMFREE DATAID("temp")" Address ISPEXEC "LIBDEF ISPPLIB" junk = msg(off) "FREE FI("ddnm1")" "FREE FI("ddnm2")" Exit TOKENIZE: Procedure expose DELIM. TOKEN. R_ADDR /*********************************************************************/ /* Routine to tokenize the input address */ /*********************************************************************/ Parse upper arg ADDR_STR DELIM.1 = '?' DELIM.2 = '+' DELIM.3 = '-' DELIM.4 = '%' DELIM.5 = '.' DELIM.0 = 5 REFCNT = 1 Do while length(ADDR_STR) > 0 REF_FND = verify(ADDR_STR,'?+-%.','M') If REF_FND > 0 then do If REF_FND > 1 then do TOKEN.REFCNT = Substr(ADDR_STR,1,REF_FND-1) REFCNT = REFCNT + 1 End /* if REF_FND > 1 ... */ TOKEN.REFCNT = Substr(ADDR_STR,REF_FND,1) ADDR_STR = Substr(ADDR_STR,REF_FND+1) REFCNT = REFCNT + 1 End /* if REF_FND > 0 ... */ Else do TOKEN.REFCNT = ADDR_STR ADDR_STR = '' REFCNT = REFCNT + 1 End End /* do while ...*/ TOKEN.0 = REFCNT - 1 Return RESOLVE_ADDR: Procedure expose DELIM TOKEN. /*********************************************************************/ /* Routine to resolve indirect addressing */ /*********************************************************************/ ADDR = Arg(1) /* LINE = ADDR */ LINE = "x'" || D2x(ADDR) || "'" Do RSLV=2 to TOKEN.0 If TOKEN.RSLV = '?' then do RESULT = C2x(Storage(D2x(ADDR),4)) ADDR = X2d(RESULT) LINE = LINE||TOKEN.RSLV Queue LINE "=" D2x(ADDR) End If TOKEN.RSLV = '%' then do RESULT = C2x(Storage(D2x(ADDR),4)) RESULT = Substr(RESULT,3,6) /* 24-bit pointer */ ADDR = X2d(RESULT) LINE = LINE||TOKEN.RSLV Queue LINE "=" D2x(ADDR) End If TOKEN.RSLV = '+' then do RSLV = RSLV + 1 ADDR = ADDR + X2d(TOKEN.RSLV) LINE = LINE||"+x'"TOKEN.RSLV"'" Queue LINE "=" D2x(ADDR) End If TOKEN.RSLV = '-' then do RSLV = RSLV + 1 ADDR = ADDR - X2d(TOKEN.RSLV) LINE = LINE||"-x'"TOKEN.RSLV"'" Queue LINE "=" D2x(ADDR) End If TOKEN.RSLV = '.' then do /* LINE = LINE||""TOKEN.RSLV */ /* Queue LINE "=" D2x(ADDR) */ End End If TOKEN.0 > 1 then do /* Improve readability - add lines before storage display if */ /* indirect storage references are used. */ Queue '---------------------------------------------------' || , '---------------------------' Queue ' ' End Return ADDR /*********************************/ /* HELP SUB-ROUTINES */ /*********************************/ HELP_INCL: Return SIGL HELP_DISPLAY: Queue '===================' Queue '=== H E L P ===' Queue '===================' Do hlp = help_start+1 to help_end-1 by 1 hline = Sourceline(hlp) Queue hline End Return SYNTAX: Say ERRORTEXT(rc) /* return code */ Say 'Please verify input parameters for valid hex characters' , 'and proper indirect storage addressing.' "Delstack" /* delete data stack */ Exit 12