/* REXX - */ /* */ /* AUTHOR: Mark Zelden */ /* */ /*********************************************************************/ /* 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. */ /* */ /* NOTE #1: If no length is specified, then the default is 100 (hex).*/ /* */ /* NOTE #2: If any storage in the range is protected, then none of */ /* it can be displayed. This is how the REXX STORAGE */ /* function works. */ /* */ /*********************************************************************/ /* */ /* Examples: */ /* TSO %REXXMEM (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') */ /* */ /*********************************************************************/ Arg R_ADDR R_LEN /*********************************************************************/ LASTUPD = '10/09/2007' /* date of last update */ /*********************************************************************/ Signal On Syntax /* error condition */ Numeric digits 12 /* dflt of 9 not enough */ If R_LEN = '' then R_LEN = 100 /* dflt length */ R_ADDR = Translate(R_ADDR,"","xX'") /* remove hex notation */ R_ADDR = Strip(R_ADDR) /* remove blanks */ R_ADDR = X2d(R_ADDR) /* change to dec for rexx */ R_LEN = Translate(R_LEN ,"","xX'") /* remove hex notation */ R_LEN = Strip(R_LEN) /* remove blanks */ R_LEN = X2d(R_LEN) /* change to dec for rexx */ /*********************************************************************/ /* 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.' Exit 12 End D_STORX = C2x(D_STOR) D_STORL = Length(D_STORX) /*********************************************************************/ /* 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 */ Queue D_ADDR '' D_OFF2 '' D_STORX1 '' D_STORX2 '' D_STORX3 , '' D_STORX4 ' |' D_STOR_E '|' 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 */ /***************************************************************/ 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 = 'DDO'||random(1,99999) /* choose random ddname */ ddnm2 = 'DDP'||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)" 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'" /* Queue " &ZTITLE = 'Mark''s MVS Utilities - REXXMEM'" */ Queue " &ZTITLE = 'Mark''s MVS Utilities -" , "STOR(" || D2x(R_ADDR) || "," || D2x(R_LEN) || ")'" 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 "" /* */ Address ISPEXEC "LMINIT DATAID(PAN) DDNAME("ddnm2")" Address ISPEXEC "LMOPEN DATAID("pan") OPTION(OUTPUT)" Do queued() Parse pull panline Address ISPEXEC "LMPUT DATAID("pan") MODE(INVAR)" , "DATALOC(PANLINE) DATALEN(80)" End Address ISPEXEC "LMMADD DATAID("pan") MEMBER(REXXMEMP)" Address ISPEXEC "LMFREE DATAID("pan")" "Delstack" "EXECIO * DISKW" ddnm1 "(FINIS" zedsmsg = 'Storage displayed' zedlmsg = 'REXXMEM - Last updated on' , LASTUPD ||'. Written by' , 'Mark Zelden. Mark''s MVS Utilities -' , 'http://home.flash.net/~mzelden/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 Syntax: Say ERRORTEXT(rc) /* return code */ Say 'Please verify input parameters' Exit 12 End