PROCEDURE qcm$display_pp_assignments, disppa (
 status )

chad e=m
crev ssr k=integer v= 400001000(16)
ssr = ssr + 64(16)*8     "offset of pp assignment table

" If first bit of byte is set (80 for instance) then VE owns the resource.
"
" If byte is 0F or FF then VE can't have access to it.
"
" If byte is zero then VE can use the resource if it needs it.
"

" The vpp array in ssr consists of four blocks of 32(8) bytes,
" the blocks represent
"                      NIO pp's for IOU 0
"                      CIO pp's for IOU 0
"                      NIO pp's for IOU 1
"                      CIO pp's for IOU 1
"
" The following pps are eligable for assignment,
" 0 - 3, 4 - 7, 10-12
" 20 - 23, 24 - 31, 32
" PPs 13 - 17 and 33 and 34 can never be assigned because
" there is no channel counterpart (actually there is a
" channel but no pp)


putl '-'
putl '          PP and Channel assignments from SSR'
putl ' '
lpp = 0
lch = 0

ppp = 0
pch = 0

crev base k=string d=1..4
base(1) = 'NIO PPs on IOU 0'
base(2) = 'CIO PPs on IOU 0'
base(3) = 'NIO PPs on IOU 1'
base(4) = 'CIO PPs on IOU 1'

FOR j = 1 TO 4 DO
  putl '-'
  putl ' '//base(j)
  putl ' '
FOR i = 0 TO 33(8) DO
 pch = $mem(ssr,1)
 ppp = $mem(ssr+1,1)
   chm = ' '
   IF pch = 0 THEN
      chm = 'Available'
   ELSE
      IF pch - 0f(16) = 0 THEN
         chm = 'Not Available'
      IFEND
   IFEND
   IF chm = '' THEN
      pch = pch - 80(16)
      chm = 'Is assigned to PP '//$strrep(pch,8)
   IFEND


   ppm = ' '
   IF ppp = 0 THEN
      ppm = 'Available'
   ELSE
      IF ppp - 0f(16) = 0 THEN
         ppm = 'Not Available'
      IFEND
   IFEND
   IF ppm = '' THEN
      ppp = ppp - 80(16)
      ppm = 'Is assigned to channel '//$strrep(ppp,8)
   IFEND
msg =' CH '//$strrep(i,8)
msg = msg//$substr('',1,7-$strlen(msg))//chm
msg = msg//$substr('',1,27-$strlen(msg))//' PP '//$strrep(i,8)
msg = msg//$substr('',1,35-$strlen(msg))//ppm
putl '     '//msg

  ssr = ssr+2
  FOREND
FOREND



PROCEND qcm$display_pp_assignments
