/* Rexx - create svc99 test program from ispvcall trace              */
/*        Get >Svc99 lines in a member and invoke this macro.        */
/*        The resulting program should be run with tso profile wtp.  */
/*                                                                   */
/*        Edit as needed.  This was written as a personal time saver.*/
/*                                                                   */
/*  To run: Place in a sysproc or sysexec data set                   */
/*          Tso ispvcall                                             */
/*          Do something in ispf to cause allocation like browse a ds*/
/*          Tso ispvcall (This will start the editor on a trace)     */
/*          Makesv99                                                 */
/*  Author : Doug Nadel                                              */

Address isredit
'MACRO'
'X ALL'
'F >SVC99 ALL 1'
'(MEMBER) = MEMBER'
flags='4400' /* assume 4400 as flags used */
member=strip(member)
If member='' Then member='SVCTEST'
'F ">SVC99 END" first'
If rc=0 Then /* try to get flags from section after execution */
  Do
    'F "flags=" next'
    If rc=0 Then
      Do
        '(LINE) = line .zcsr'
        Parse Var line . 'Flags='flags .
      End
  End
'F ">SVC99 END" first'
If rc=0 Then 'X ALL .ZCSR .ZLAST'
'DEL ALL X'
type=1
ctyp=''
'F "Type=" first'
If rc=0 Then
  Do
    '(LINE) = line .zcsr'
    Parse Var line . 'Type='ctyp .
    Select
    When(ctyp='Allocate')      Then type=1
    When(ctyp='Unallocate')    Then type=2
    When(ctyp='Concatenate')   Then type=3
    When(ctyp='Deconcatenate') Then type=4
    When(ctyp='Remove In Use') Then type=5
    When(ctyp='DD Allocate')   Then type=6
    When(ctyp='Info Retrieve') Then type=7
    Otherwise                       type=1
    End
  End
'X ALL P" ### " 26'
'X ALL P" ## " 23'
'DEL ALL NX'
'RESET'
'(LAST) = LINENUM .ZL'
tucount=0
Do a = 1 to last
  '(LINE) = LINE 'a
  Parse Var line svc99 desc 19 key num 27 len val comment
  If svc99='>SVC99' Then
    Do
      If num\='' Then
        Do
          tucount=tucount+1
          line='TU'right(tucount,4,'0')'   DC X'''key''',AL2('num+0')'
          If num>0 Then
            Do
              line=line||',AL2('len+0'),'
              If val='' Then val = ' '
              If key='0057' Then val="X'0000'" /* ret dsorg */
              If key='005D' | key='0056' Then val=' ' /* ret vol,dsn */
              If substr(val,1,2)="X'" Then line=line||val
              Else line=line||'CL'||max(1,0+len)||"'"val"'"
            End
          line=substr(line,1,max(length(line),50)) space(desc comment)
        End
      Else
        Do
          line='         DC AL2('len+0'),'
          If val='' Then val = ' '
          If substr(val,1,2)="X'" Then line=line||val
          Else line=line||'CL'||0+len||"'"val"'"
          line=substr(line,1,max(length(line),50)) space(desc comment)
        End
      line=substr(line,1,71)
      'LINE 'a' = (LINE)'
    End
End
line='TULIST   DC A('
Do n=1 to tucount
  unit='TU'right(n,4,'0')
  If n=tucount Then unit=unit||"+X'80000000'"
  If length(line)+length(unit)>69 Then
    Do
      line=line')'
      'LINE_AFTER .ZL = (LINE)'
      line='         DC A('
    End
  If substr(line,length(line),1)\='(' Then line=line||','
  line=line||unit
  If n=tucount Then
    Do
      line=line')'
      'LINE_AFTER .ZL = (LINE)'
      line='         DC A('
    End
End
'LINE_AFTER  0 = (LINE)'
'LABEL .ZFIRST = .TEMP 0'
Call write left(member,9)||"CSECT ,        Simplified SVC 99 invocation"
Call write left(member,9)||"AMODE 31       Generated to duplicate SVC  "
Call write left(member,9)||"RMODE 24       call made by ISPF           "
Call write "         BAKR  14,0     "substr(time(),1,5)' - 'date('U')
Call write "         LR    12,15    Run this with TSO PROFILE WTP"
Call write "         USING "member",12 "copies('-',35)
Call write "         LA    1,S99RBPTR             Get addr of parm list"
Call write "         LR    2,1                    Save R1 for TSO TEST"
Call write "         SVC   99                     Call Dynalloc  "
Call write "         L     0,S99ERROR             Save error code"
Call write "         NOPR  0"right("Place for TSO test breakpoint",51)
Call write "         PR    ,                      Return to caller"
Call write "S99RBPTR DC A(X'80000000'+S99RB)   Address of request block"
Call write "S99RB    DC AL1(20),AL1("type"),XL2'"flags"'  "ctyp",Flags"
Call write "S99ERROR DC AL2(0)                    Returned error code "
Call write "S99INFO  DC AL2(0)                    Returned info code  "
Call write "S99TXTPP DC A(TULIST,EXTBLOCK,0)      Pointer to text units"
"LINE_AFTER .ZLAST = '         END "member"'"
"DEL ALL .TEMP .TEMP"
"LABEL .ZLAST = .TEMP 0"
Call write "EXTBLOCK DC CL6'S99RBX',X'01',X'C4',XL200'00'  Ext. block."
"RESET LABEL"
Do queued();Pull;End
if userid()='NADEL' then
  do
    Say 'Replace PRIVATE.ASM(SVCTEST)? (Y/N, Default=N)'
    Parse Upper Pull ans 2 .
    If ans='Y' Then
     Do
       'REPLACE .ZL .ZF PRIVATE.ASM(SVCTEST)'
        Say 'Submit DGN.CNTL(SVCTEST)? (Y/N, Default=N)'
        Parse Upper Pull ans 2 .
        If ans='Y' Then Address tso 'SUB DGN(SVCTEST)'
     End
  End
Exit 1
write:
Parse Arg line
'LINE_BEFORE .TEMP = (LINE)'
Return