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 
         SACPORT,OCPPORT,ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, C 
         BLKADDR,DPTADDR,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,SP0,SP1,SP2,SP3, C 
         SP4,SP5,SP6,SP7,SP8,SP9, 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  PROCF(STRING (6) USER,  C 
         BYTEINTEGER  INCAR,CATEGORY,WSN,RUNQ,ACTIVE, C 
         INTEGER  ACTWO,LSTAD,LAMTX,STACK,STATUS)
RECORDFORMAT  USTABF(INTEGER  NEXT,STATUS, STRING (6) NAME)
EXTERNALINTEGERFNSPEC  DPROCS(INTEGERNAME  MAXPROCS, INTEGER  ADR)
!
!
!
ROUTINE  DELUXE(INTEGER  MAXPROCS)
BYTEINTEGERARRAY  PROCLIST(0:32*MAXPROCS)
RECORDARRAYFORMAT  PROCAF(0:MAXPROCS)(PROCF)
RECORDARRAYNAME  PROCA(PROCF)
RECORDARRAY  USTAB(0:MAXPROCS)(USTABF)
INTEGER  I,J,FLAG,NUSERS,NEXTFREE,START,DUMMY,ADR,K,LAST
STRING (255) SOUT
NUSERS=0
NEXTFREE=0
START=0
DUMMY=0
ADR=0
FLAG=DPROCS(MAXPROCS, ADDR(PROCLIST(0)))
WRITE(FLAG,4) AND  RETURN  IF  FLAG#0
MAXPROCS = MAXPROCS-1
PROCA==ARRAY(ADDR(PROCLIST(0)),PROCAF)
CYCLE  J=0,1,MAXPROCS
IF  PROCA(J)_USER#"" THEN  START 
! USER IS ON
IF  PROCA(J)_USER#"DIRECT" AND  PROCA(J)_USER#"VOLUMS" C 
AND  PROCA(J)_USER#"SPOOLR" THEN  START 
NUSERS=NUSERS+1
USTAB(NEXTFREE)_NAME=PROCA(J)_USER
USTAB(NEXTFREE)_STATUS=PROCA(J)_STATUS
IF  NEXTFREE=0 THEN  USTAB(NEXTFREE)_NEXT=-1 AND  C 
NEXTFREE=NEXTFREE+1 ELSE  START 
K=START
LAST=START
CYCLE 
EXIT  IF  USTAB(NEXTFREE)_NAME<USTAB(K)_NAME OR  USTAB(K)_NEXT=-1
LAST=K
K=USTAB(K)_NEXT
REPEAT 
IF  K=START THEN  START 
IF  USTAB(NEXTFREE)_NAME>USTAB(K)_NAME THEN  C 
USTAB(NEXTFREE)_NEXT=USTAB(K)_NEXT AND  USTAB(K)_NEXT=NEXTFREE C 
ELSE  USTAB(NEXTFREE)_NEXT=K AND  START=NEXTFREE
FINISH  ELSE  START 
IF  USTAB(NEXTFREE)_NAME>USTAB(K)_NAME THEN   C 
USTAB(NEXTFREE)_NEXT=USTAB(K)_NEXT AND  USTAB(K)_NEXT=NEXTFREE C 
ELSE  START 
USTAB(NEXTFREE)_NEXT=USTAB(LAST)_NEXT
USTAB(LAST)_NEXT=NEXTFREE
FINISH 
FINISH 
NEXTFREE=NEXTFREE+1
FINISH 
FINISH 
FINISH 
REPEAT 
! OUTPUT SEGMENT
! %CYCLE I=0,1,NEXTFREE-1
! PRINTSTRING(USTAB(I)_NAME."  ")
! WRITE(USTAB(I)_NEXT,3)
! NEWLINE
! %REPEAT
I=START
PRINTSTRING("Current users are:
(* == background)

")
SOUT=""
J=START
CYCLE  I=1,1,NEXTFREE
SOUT=SOUT.USTAB(J)_NAME
IF  USTAB(J)_STATUS&4=4THEN  SOUT=SOUT."* " ELSE  C 
SOUT=SOUT."  "
IF  (I>>3)<<3=I OR  I=NEXTFREE THEN  START 
PRINTSTRING(SOUT.TOSTRING(10))
SOUT=""
FINISH 
J=USTAB(J)_NEXT
REPEAT 
NEWLINE
WRITE(NUSERS,12)
PRINTSTRING(" Users")
RETURN 
END ;  ! OF DELUXE
EXTERNALROUTINE  WHOSON(STRING (255) S)
INTEGER  MAXPROCS
RECORDNAME  COM(COMF)
      COM==RECORD(X'80000000'+48<<18)
      MAXPROCS=COM_MAXPROCS
      DELUXE(MAXPROCS)
      RETURN 
END ; ! OF WHOSON
ENDOFFILE