/* QVX EXEC - Query Virtual (EXTENDED).                      */
/*************************************************************/
/*                                                           */
/* (C) International Business Machines Corp., 1997           */
/*     Dennis Musselwhite, VM and CP Development.            */
/*                                                           */
/* This programming example is to be used as a sample        */
/* program only.  Although this program may have been        */
/* reviewed by IBM for accuracy in a specific environment,   */
/* there will be no guarantee that the same or similar       */
/* results will be obtained elsewhere.  The code is          */
/* being provided on an 'As is' basis without any            */
/* warranty expressed or implied.                            */
/*                                                           */
/* History:                                                  */
/*   Version 01.01 (04/30/1997) Dennis Musselwhite           */
/*     Initial version to assist with collecting             */
/*     information about Virtual CTCA problems.              */
/*   Version 01.02 (01/16/1998) Dennis Musselwhite           */
/*     Updated with a reminder that the invoker must         */
/*     be authorized for CP LOCATE and DISPLAY Host.         */
/*                                                           */
/*************************************************************/
  Parse Upper Source . . EN .  /* EN=ExecName */
  EV = '01.02 (01/16/1998)' /* EV=ExecVersion */
  Numeric Digits 12
  NL = '00000000' /* Constant = Null Address */
  Say EN 'Version' EV
  Parse Upper Arg arg1 parms
  If (arg1='?') Then
    retval = Help(parms)
  Else
    retval = QueryVDEV(arg1 parms)
Exit retval
 
/*************************************************************/
/* Help() Returns(rc)                                        */
/*************************************************************/
Help:
  Say 'Syntax:' EN 'userid|* vdev <DUMP>'
  Say '  to display information about a virtual device'
  Say '  which may be owned by another VM user.  To use'
  Say '  this command, the invoker must be authorized to'
  Say '  use the CP LOCATE and CP DISPLAY HOST commands.'
  Say '  If the keyword "DUMP" is specified, this command'
  Say '  will display the virtual device storage on the'
  Say '  invoker''s console.'
  Say 'Example:' EN 'MAINT 400'
  Say '  To view system information regarding the VCTC defined'
  Say '  for userid MAINT at virtual device address 400.'
  Say 'Note:'
  Say '  This routine only handles Virtual CTCA devices.'
Return 0 /* Help */
 
/*************************************************************/
/* QueryVDEV(user vdev options) Returns(rc)                  */
/*************************************************************/
QueryVDEV:
  Parse Upper Arg owner vaddr options
  If (owner='*') Then owner = Userid()
  DisplayBlocks = (WordPos('DUMP',options)>0)
  CPlevel = QueryCPLEVEL()
  VDEVINTV = '80'  /* VDEVAFLG - Intervention Required */
  VDEVDED  = '08'  /* VDEVAFLG - Dedicated Device */
  VDEV_length = '124' /* hex bytes (VDEVBYLN) */
  VDEV_address = LocateVDEV(owner vaddr)
  If (VDEV_address='') Then
    Return rc /* Locate failed (msg already issued) */
  VDEV_data = HostStorage(VDEV_address,100)
  If (DisplayBlocks) Then
  Do
    Say '========' owner vaddr 'VDEV at' VDEV_address ':'
    Call Display VDEV_address,VDEV_data
  End
  VDEVSUB  = Offset(VDEV_data,10,2)
  VDEVCODE = Offset(VDEV_data,12,2)
  VDEVUSER = Offset(VDEV_data,14,4)
  VDEVAFLG = Offset(VDEV_data,1A,1)
  VDEVDEV  = Offset(VDEV_data,26,2)
  Select
    When (VDEVCODE='0280') Then
      rc = QueryCTCA() /* Handle Virtual CTCA */
/** When (VDEVCODE='xxxx') Then ******************************/
/**   rc = QueryXXXX() ***************************************/
    Otherwise
      Return Error('004E Sorry; Device class' VDEVCODE,
                        'is not supported by this command.')
  End /* Select */
Return rc /* QueryVDEV */
 
/*************************************************************/
/* QueryCTCA() Returns(rc)                                   */
/*************************************************************/
QueryCTCA:
  If (TM(VDEVAFLG,VDEVDED)=3) Then
    Return Error('020E Device' owner vaddr 'is a DEDICATED CTCA.')
  VDEVCUSR = Offset(VDEV_data,78,8)
  VDEVCTCA = Offset(VDEV_data,80,4)
  Select
    When (CPlevel<'02100000') Then /* VVRMssss */
      rc = QueryCTCAold() /* Use VDEV* fields */
    Otherwise
      rc = QueryCTCA210() /* Use VDEV* fields */
  End /* Select */
Return rc /* QueryCTCA */
 
/*************************************************************/
/* QueryCTCAold() Returns(rc)                                */
/*************************************************************/
QueryCTCAold:
  CACICMDE = '40'  /* CAC*LTCH - Inhibit Compatibility Mode */
  CACNTRDY = '20'  /* CAC*LTCH - This side is NOTREADY */
  CACBK_length = '40'
  CACX_data = HostStorage(VDEVCTCA,CACBK_length) /* CACBK(X) */
  If (DisplayBlocks) Then
  Do
    Say '========' owner vaddr 'CACBK at' VDEVCTCA ':'
    Call Display VDEVCTCA,CACX_data
  End
  CACXYCAC = Offset(CACX_data,20,4)
  CACXLTCH = Offset(CACX_data,16,1)
 
  If (CACXYCAC<>NL) Then
  Do
    CACY_data = HostStorage(CACXLINK,CACBK_length) /* CACBK(Y) */
    If (DisplayBlocks) Then
    Do
      Say '========' owner vaddr 'Y-SIDE at' CACXYCAC ':'
      Call Display CACXYCAC,CACY_data
    End
    CACYVDEV = Offset(CACY_data,08,4) /* Y-SIDE VDEV */
    Y_VDEV_data = HostStorage(CACYVDEV,VDEV_length)
    Y_VDEVDEV = Offset(Y_VDEV_data,26,2)
    Y_VDEVUSER = Offset(Y_VDEV_data,14,4) /* Y-SIDE VMDBK */
    Y_VMDBK_data = HostStorage(Y_VDEVUSER,88,8)
    Y_VMDUSER = Offset(Y_VMDBK_data,80,8)
    CACYLTCH = Offset(CACY_data,16,1)
    OtherDevice = x2c(Y_VMDUSER) Y_VDEVDEV
  End
  Else /* Uncoupled Adapter */
  Do
    OtherDevice = Left('(none)',8) 'none' /* never displayed */
    CACYLTCH = CACNTRDY /* Simulate BASIC and NOTREADY */
  End
 
  MsgDev = Left(owner,8) 'CTCA' VDEVDEV
  MsgSCHID = 'SUBCHANNEL =' VDEVSUB
 
  If (TM(VDEVAFLG,VDEVINTV)=3) Then
  Do
    If (VDEVCUSR='0000000000000000') Then
      AuthUser = Left('*',8)
    Else
      AuthUser = x2c(VDEVCUSR)
    Say MsgDev 'NOT READY  RESTRICTED TO' AuthUser MsgSCHID
  End
  Else /* COUPLED device */
  Do
    Say MsgDev 'COUPLED TO ' OtherDevice MsgSCHID
  End
 
  If (TM(CACXLTCH,CACICMDE)=3 | TM(CACYLTCH,CACICMDE)=3) Then
  Do
    Say '* This adapter is OPERATING in Extended Mode'
    XYcc = TM(CACXLTCH,CACNTRDY) || TM(CACYLTCH,CACNTRDY)
    Select
      When (XYcc='00') Then
        Say '* Both sides are READY'
      When (XYcc='03') Then
        Say '* This side is READY and Y-SIDE is NOTREADY'
      When (XYcc='30') Then
        Say '* This side is NOTREADY and Y-SIDE is READY'
      When (XYcc='33') Then
        Say '* Both sides are NOTREADY'
    End
  End
  Else
    Say '* This adapter is OPERATING in Basic Mode'
Return 0 /* QueryCTCAold */
 
/*************************************************************/
/* QueryCTCA210() Returns(rc)                                */
/*************************************************************/
QueryCTCA210:
  CACEXTOP = '80'  /* CAC*LTCH - Operating in Extended Mode */
  CACEXTND = '40'  /* CAC*LTCH - Extended Mode SET on this side */
  CACNTRDY = '20'  /* CAC*LTCH - This side is NOTREADY */
  CACBK_length = '48'
  CACX_data = HostStorage(VDEVCTCA,CACBK_length) /* CACBK(X) */
  If (DisplayBlocks) Then
  Do
    Say '========' owner vaddr 'CACBK at' VDEVCTCA ':'
    Call Display VDEVCTCA,CACX_data
  End
  CACXLINK = Offset(CACX_data,14,4)
  CACXLTCH = Offset(CACX_data,0C,1)
  CACY_data = HostStorage(CACXLINK,CACBK_length) /* CACBK(Y) */
  If (DisplayBlocks) Then
  Do
    Say '========' owner vaddr 'Y-SIDE at' CACXLINK ':'
    Call Display CACXLINK,CACY_data
  End
  CACYUSER = Offset(CACY_data,00,8) /* Partner's userid */
  CACYADDR = Offset(CACY_data,08,2) /* Partner's vaddr */
  CACYLTCH = Offset(CACY_data,0C,1)
 
  MsgDev = Left(owner,8) 'CTCA' VDEVDEV
  MsgSCHID = 'SUBCHANNEL =' VDEVSUB
 
  If (TM(VDEVAFLG,VDEVINTV)=3) Then
  Do
    If (VDEVCUSR='0000000000000000') Then
      AuthUser = Left('*',8)
    Else
      AuthUser = x2c(VDEVCUSR)
    Say MsgDev 'NOT READY  RESTRICTED TO' AuthUser MsgSCHID
  End
  Else /* COUPLED device */
  Do
    OtherDevice = x2c(CACYUSER) CACYADDR
    Say MsgDev 'COUPLED TO ' OtherDevice MsgSCHID
  End
 
  If (TM(CACXLTCH,CACEXTOP)=3) Then
  Do
    Say '* This adapter is OPERATING in Extended Mode'
    XYcc = TM(CACXLTCH,CACNTRDY) || TM(CACYLTCH,CACNTRDY)
    Select
      When (XYcc='00') Then
        Say '* Both sides are READY'
      When (XYcc='03') Then
        Say '* This side is READY and Y-SIDE is NOTREADY'
      When (XYcc='30') Then
        Say '* This side is NOTREADY and Y-SIDE is READY'
      When (XYcc='33') Then
        Say '* Both sides are NOTREADY'
    End
  End
  Else
    Say '* This adapter is OPERATING in Basic Mode'
Return 0 /* QueryCTCA210 */
 
/*************************************************************/
/* QueryCPLEVEL() Returns(vvrmssss)                          */
/*   Convert the response to QUERY CPLEVEL into a simpler    */
/*   form for comparison.  The expected response is:         */
/*     VERSION v RELEASE r.m, SERVICE LEVEL ssss             */
/*************************************************************/
QueryCPLEVEL:
  Parse Upper Value Diag(8,'QUERY CPLEVEL') With ,
    . 'VERSION' CPversion . CPrelease '.' CPmodification ,
    ',' . . CPservice . '15'x
  CPlevel = Right(CPversion,2,0)||CPrelease||CPmodification,
    ||Right(CPservice,4,0)
Return CPlevel /* QueryCPLEVEL */
 
/*************************************************************/
/* LocateVDEV(ownerid,vcuu) Returns(hexaddr)                 */
/*************************************************************/
LocateVDEV:
  Parse Upper Arg VDEV_owner VDEV_cuu .
  /* Note: This only works when the user has CP LOCATE priv */
  Parse Value Diag(8,'LOCATE' VDEV_owner VDEV_cuu),
    With locate_labels '15'x locate_info '15'x .
  If (Space(locate_labels) = 'VMDBK VDEV') Then
    Parse Var locate_info . locate_vdev .
  Else
  Do
    rc = Error('012E CP LOCATE' VDEV_owner VDEV_cuu 'failed.')
    Say '* Note: The invoker needs authority for',
       'the LOCATE and DISPLAY Host commands.'
    locate_vdev = '' /* Not Found */
  End
Return locate_vdev /* LocateVDEV */
 
/*************************************************************/
/* Display(hexaddr,hexdata) Returns(rc)                      */
/*************************************************************/
Display:
  Parse Arg dump_hexaddr,dump_hexdata
  dump_ptr = x2d(dump_hexaddr)
  Do While (dump_hexdata<>'')
    Parse Var dump_hexdata 1 dump_hex 33 dump_hexdata
    Parse Var dump_hex 1 h1 9 h2 17 h3 25 h4 .
    dump_txt = x2c(dump_hex)
    dump_hex = Left(h1 h2 h3 h4,(4*8+3))
    dump_txt = Translate(dump_txt,,Xrange('00'x,'1F'x),'.')
    Say d2x(dump_ptr,8) dump_hex '|'||dump_txt||'|'
    dump_ptr = dump_ptr + 16
  End /* Do While (dump_hexdata<>'') */
Return 0 /* Display */
 
/*************************************************************/
/* HostStorage(hexaddr,hexlen) Returns(hexstring)            */
/*************************************************************/
HostStorage:
  Parse Arg stgptr,stglen
  stgbase = (x2d(stgptr)%16)*16 /* Addr of first 16-byte line */
  stgoffset = x2d(stgptr) - stgbase
  stgsize = x2d(stglen) + stgoffset
  stg = ''
  Do While Length(stg) < stgsize*2
    CPrsp = DiagRC(8,'DISPLAY H'||d2x(stgbase)||'.10')
    Parse Var CPrsp rc cc . h1 h2 h3 h4 . '15'x
    If rc=0 Then
      stg = stg || h1 || h2 || h3 || h4
    Else /* rc^=0 */
      stg = stg || Copies('0',32)
    stgbase = stgbase + 16
  End
  stg = Substr(stg,(stgoffset*2)+1,(x2d(stglen)*2))
Return stg /* HostStorage */
 
/*************************************************************/
/* Offset(hexstring,hexoffset,hexlen) Returns(hexstring)     */
/*************************************************************/
Offset:
  Parse Arg $str,$offset,$len
  If x2d($len)<=0 Then Return '' /* not enough room for data */
Return Substr($str,1+(x2d($offset)*2),(x2d($len)*2)) /* Offset */
 
/*************************************************************/
/* TM(hexstring,bitdef) Returns(cc)                          */
/*************************************************************/
TM:
  Parse Arg tm_str,tm_bit
  tm_result = BitAND(x2c(tm_str),x2c(tm_bit))
  Select
    When tm_result = '00'x Then tm_cc = 0 /* ZEROES */
    When tm_result = x2c(tm_bit) Then tm_cc = 3 /* ONES */
    Otherwise tm_cc = 1 /* MIXED */
  End /* Select */
Return tm_cc /* TM */
 
/*************************************************************/
/* Error(rc message) Returns(rc)                             */
/*************************************************************/
Error:
  Parse Arg error_rc error_msg
  error_code = Right(error_rc,1)
  rc = Left(error_rc,(Length(error_rc)-1))
  Say Right(rc,3,0)||error_code error_msg
Return rc /* Error */