%dynamicstringfnspec itos(%integer value)
%dynamicintegerfnspec outpos
%systemroutinespec phex(%integer i)
%dynamicroutinespec dump(%integer a,b,c,d)
%dynamicintegerfnspec nwfilead(%string(255) s,%integer epgs)
%systemroutinespec move(%integer len,from,to)
%externalintegerfnspec dconnect(%string(6) user,  %c
   %string(15) file,%integer fsys,mode,apf,%integername seg,gap)
%externalintegerfnspec ddisconnect(%string(6) user,%string(15) file  %c
   , %integer fsys,destroy)
!
!* communications record format - extant from chopsupe 20f onwards *
%recordformat comf(%integer ocptype,ipldev,sblks,sepgs,ndiscs,  %c
         ddtaddr,gpctabsize,gpca,sfctabsize,sfca,sfck,dirsite,  %c
         dcodeda,suplvn,wasklokcorrect,date0,date1,date2,  %c
         time0,time1,time2,epagesize,users,cattad,dqaddr,  %c
         %byteinteger nsacs,resv1,sacport1,sacport0, %c
         nocps,resv2,ocpport1,ocpport0, %c
         %integer itint,contypea,gpcconfa,fpcconfa,sfcconfa, %c
         blkaddr,ration,smacs,trans,%longinteger kmon,  %c
         %integer ditaddr,smacpos,supvsn,pstva,secsfrmn,secstocd, %c
         sync1dest,sync2dest,asyncdest,maxprocs,inspersec,elaphead, %c
         commsreca,storeaad,procaad,sfcctad,drumtad,tslice,sp0,sp1, %c
         sp2,sp3,sp4,sp5,sp6,sp7,sp8, %c
         lstl,lstb,pstl,pstb,hkeys,hoot,sim,clkx,clky,clkz,  %c
         hbit,slaveoff,inhssr,sdr1,sdr2,sdr3,  %c
         sdr4,sesr,hoffbit,s2,s3,s4,end)
!
%recordformat procdatf(%string(6) user,%byteinteger invoc,  %c
   %string(1) suffix,  %c
   %integer fsys,reason,id,asyncdest,process,prev warn,sessend,  %c
   %byteinteger sp,pre empt,blnk,link)
!
%constinteger endlist=255
!
%stringfn hhmm bin(%integer mins frmn)
! Parameter is time as number of minutes from midnight.
! Result is time expressed as string hh.mm
%integer hr,min
%string(15) hs,ms
      %result="    0" %if mins frmn=0
      hr=mins frmn//60
      hs=itos(hr)
      hs="0".hs %if length(hs)=1
      min=mins frmn - 60*hr
      ms=itos(min)
      ms="0".ms %if length(ms)=1
      %result=hs.".".ms
      %end;                            ! hhmm bin
%externalroutine show sys (%string(25) s)
%recordformat logf hdf(%integer logmapst,proclst,  %c
   %byteinteger freehd,livehd,backhd)
%integer j,seg,gap,fad,cur,ct,bct,ration,brief
!
%recordformat procdatf(%string(6) user,%byteinteger invoc,  %c
   %string(1) suffix,  %c
   %integer fsys,reason,id,process,prev warn,sessend,  %c
   %byteinteger sp,pre empt,blnk,link)
!
%recordarrayformat pdf(0:255)(procdatf)
%recordname h(logf hdf)
%recordarrayname p(procdatf)
%recordname c(procdatf)
%recordname com(comf)
%byteintegername livehd,backhd
%conststring(11)%array re(0:2)="Interactive","OPER","Batch"
%constintegerarray     sre(0:2) = ' ', '*', '='
      brief = 0; brief = 1 %if s # ""
      com==record(x'80000000'+48<<18)
      ration=com_ration
      %if brief = 0 %start
         printstring("sCARCITY AT")
         write(ration>>24,3)
         printstring("  USERS")
         newline
         printstring("pRE-EMPT AT")
         write((ration>>16)&255,3)
         printstring("  USERS")
         newline
         printstring("cURRENT INTERACTIVE USERS:")
         write(ration&255,3)
         newline
      %finish
      fad=nwfilead("t#shstfil",65)
      %return %if fad=0
      seg=0; gap=0
      j=dconnect("volums","logmap",-1,9,0,seg,gap)
      write(j,1) %and newline %and %return %if j#0
      seg=seg<<18
      move(x'11'<<12,seg,fad)
      j=ddisconnect("volums","logmap",-1,0)
      write(j,1) %and newline %and %return %if j # 0
      h==record(fad)
      livehd==h_livehd
      backhd==h_backhd
      p==array(fad+h_proclst,pdf)
      %if brief = 0 %start
         spaces(39)
         printstring("sTREAM OR")
         spaces(7)
         printstring("pRE pREV  sESS")
         newline
         printstring("bLNK cELL lINK  ")
         printstring("   iNVOC  rEASON       bATCH iD")
         printstring("   pROC EMPT WARN  END")
         newline
      %finish
      ct=0
      cur=livehd
      %while cur#endlist %cycle
         ct=ct+1
         c==p(cur)
         %if brief = 0 %start
            write(c_blnk,3)
            write(cur,4)
            write(c_link,4)
            spaces(2)
         %finish
         printstring(p(cur)_user)
         %if brief = 0 %start
            space
            printstring(p(cur)_suffix)
            spaces(2)
         %finish
         j=p(cur)_reason
         %if brief = 0 %start
            %if 0<=j<=2 %then printstring(re(j)) %else write(j,11)
            spaces(39-outpos)
            phex(p(cur)_id)
            write(p(cur)_process,6)
            write(c_pre empt,3)
            write(p(cur)_prev warn,4)
            space
            printstring(hhmm bin(c_sessend))
            newline
         %finish %else %start
            %if 0 <= j <= 2 %then print symbol (sre(j)) %else space
             space
            newline %if ct & 7 = 0
         %finish
         cur=p(cur)_link
      %repeat
!      bct=0
!      cur=backhd
!      %while cur#endlist %cycle
!         bct=bct+1
!         cur=p(cur)_blnk
!         %repeat
!      %if ct#bct %then printstring("fWD/BACK ??
!")
%end
%endoffile