         TITLE 'Loser Lister'
*++
*
* Program to look up users by nameID in the task table.
*
* By John M. B. Wilson (RPI '88, '89, '92, some day!).
*
* Please send misfeature reports to "WHO Maintenance".
*
* Apr 24/86    JMBW    Created.
* Jan 26/87    JMBW    Fix end-of-job-table detection.
* Mar 15/88    JMBW    Find dev names in dev list to give term loc.
* Apr 04/88    JMBW & Michael (the Demon) Beyer  Added PAR=LS.
* Apr 03/89    JMBW    Admit we don't know loc of NIM/HIM terminals.
*
*--
*        PUNCH ' RIP  MMDVLSTL'   ;this is not enough
*
         GBLC  &BBID,&TLID
&BBID    SETC  'ACM0'             ;Big Brother's account ID
&TLID    SETC  'GZ7V'             ;TERMINALS database ID
*
         GBLB  &NEWTERM
&NEWTERM SETB  0                  ;1 => use new TERMINALS
*
         AIF   (&NEWTERM).NEWTERM
TTLDR    EQU   17                 ;old leader length
         AGO   .OLDTERM
.NEWTERM ANOP
TTLDR    EQU   19                 ;new leader length
&TLID    SETC  'EBU2'             ;it's in Dieter's account
.OLDTERM ANOP
*
LCOL     EQU   31                 ;TTY loc column -1
*
PARSTR   EQU   258                ;GUINFO item for "PAR=" string
*
         MACRO
&LAB     JSYS  &DEST,&ARGS        ;Jump to SYStem
&LAB     L     15,=V(&DEST)
         AIF   ('&ARGS' EQ '').NOARGS
         LA    1,&ARGS
.NOARGS  BASR  14,15
         MEND
*
WHO      CSECT
         ENTER (12),SA=REGS
*
         JSYS  TIME,TIMLST        ;get current time
*
         JSYS  GUINFO,GUINF       ;get PAR= string
         L     1,GULEN            ;get length
         LTR   1,1                ;was there anything?
         BZ    PAR9               ;no
         LA    2,PARBUF           ;pt at string
         LR    3,1                ;copy
         LR    4,2
         LR    5,1                ;again
         LR    6,2
         S     3,=F'2'            ;don't check last 2 posns
         BLE   PAR3               ;skip if nothing left
PAR1     CLC   0(3,4),=C'LOC'     ;PAR=LOC?
         BE    PAR2               ;yes
         LA    4,1(,4)            ;advance
         BCT   3,PAR1             ;loop
         B     PAR3               ;skip
PAR2     OI    SWITCH,LOC         ;set flag
PAR3     S     1,=F'1'            ;don't check last posn, set CC
         BLE   PAR6               ;nothing left
PAR4     CLC   0(2,2),=C'LS'      ;PAR=LS?
         BE    PAR5               ;yes
         LA    2,1(,2)            ;advance
         BCT   1,PAR4             ;loop
         B     PAR6               ;skip
PAR5     OI    SWITCH,LS          ;set flag
PAR6     S     5,=F'1'            ;don't check last
         BLE   PAR9               ;nothing
PAR7     CLC   0(2,6),=C'BB'      ;PAR=BB?
         BE    PAR8               ;yes
         LA    6,1(,6)            ;skip
         BCT   5,PAR7             ;loop
         B     PAR9               ;skip
PAR8     OI    SWITCH,BB          ;set flag
PAR9     ANOP
*
* As far as I can tell, there is no easy way to find out what
* a job's console device is, so we have to scan the whole device
* table and build a hash table from the job numbers so we can
* match them up later.  What a mess!
*
         L     11,=A(HASHT)       ;set up hash table base reg
         LR    1,11               ;point at table
         LM    2,3,=A(HASHL,HASHE) ;pt at end of table
         XR    0,0                ;load a 0
         USING HASHDS,1           ;base reg
INIT1    ST    0,CCID             ;zap user ID field
         BXLE  1,2,INIT1          ;loop
         DROP  1                  ;no longer pointing
         L     1,=V(JTBLLIM)      ;get pointer to first job
         LM    1,3,0(1)           ;get JOBTBL limits, entry size
         XR    6,6                ;init offset
* Scan job table.  Register usage:
* R0     current userID
* R1-R3  first, length of, last   ;job table entry
* R4     task # of current entry
* R5-R7  current, length of, last ;hash table entry
* R8     current nameID
* R10    total number of jobs we have found
         LM    6,7,=A(HASHL,HASHE) ;init hash ptrs
         XR    10,10              ;init user count
         USING TASKTAB,1          ;task table at (1)
JOBT1    XR    4,4                ;zero-extend
         ICM   4,3,TTASK          ;get task #
         LTR   4,4                ;is this entry used?
         BZ    JOBT5              ;no (job #=0)
         CLC   TJOBNM,=C'     MTS' ;is it an MTS job?
         BNE   JOBT5              ;no, so it couldn't be a user
         L     0,TUSER            ;get loser id
         C     0,=F'-1'           ;do they have an ID?
         BE    JOBT5              ;no, not a user task
         C     0,=C'    '         ;not sure what the diff is
         BE    JOBT5              ;we don't want those either
         L     8,TNAME            ;get nameID
         LTR   8,8                ;is a name $SET?
         BZ    JOBT5              ;no, don't bother
*
* Make an entry in the hash table
*
         LR    5,4                ;copy task #
         N     5,=F'1023'         ;isolate low 10 bits
         SLL   5,4                ;*HASHL
         XR    9,9                ;load a 0
         AR    5,11               ;add base
         USING HASHDS,5           ;R5 points to records
JOBT2    C     9,CCID             ;is this bucket taken?
         BZ    JOBT3              ;no, it's empty
         BXLE  5,6,JOBT2          ;check next one
         LR    5,11               ;wrap around
         B     JOBT2              ;keep looking (assume never full)
JOBT3    ST    0,CCID             ;save stuff
         ST    8,NAMEID
         STH   4,TASKNO
         ST    9,DEVICE           ;no device or flags yet
         STC   9,FLAGS
         AGO   .NOGETU            ;brain-dead code below
         CLC   TSTAT(8),=C'GetUnit ' ;are they %FLIPped?
         BNE   JOBT4              ;no
         MVC   DEVICE(4),TSTAT+8  ;yes, get device
         MVI   FLAGS,HARDWR+FLIPPD ;hardwired & %FLIPped
.NOGETU  ANOP
JOBT4    LA    10,1(,10)          ;count the user
         DROP  5
JOBT5    BXLE  1,2,JOBT1          ;bump ptr, loop
         DROP  1                  ;no longer pointing at jobs
*
* Find out where users are located.
*
         TM    SWITCH,LOC+BB      ;do we care?
         BZ    COMP               ;no
*
* Scan the device list for all 3270-type terminals, and fix
* all the hash table entries for which we find terminals.
*
         L     1,=V(DVLBXLE)      ;get ptr to limits
         LM    1,3,0(1)           ;get limits & index
         USING DEVLST,1           ;pointing with R1
DEVL1    TM    DVTIDX,1           ;terminal?  (tnx to D. Stussy)
         BNZ   DEVL4              ;no
         LH    0,DEVOWN           ;get owning task #
         LR    5,0                ;copy
         N     5,=F'1023'         ;compute offset in hash table
         SLL   5,4
         AR    5,11               ;add base
         LM    6,7,=A(HASHL,HASHE) ;BXLE limits
         XR    4,4                ;load 0
         USING HASHDS,5           ;R5 points at records
DEVL2    C     4,CCID             ;end of bucket?
         BZ    DEVL4              ;yup, forget it
         CH    0,TASKNO           ;is this our task?
         BE    DEVL3              ;yes, goody
         BXLE  5,6,DEVL2          ;check next one
         LR    5,11               ;wrap around
         B     DEVL2              ;keep looking
DEVL3    MVC   DEVICE,DEVNAM      ;copy device name
         CLC   DEVTYP(4),=C'TLNT' ;Telnet connection?
         BE    DEVL4              ;yes, it's mux'ed (stupid MTS!)
          OI   FLAGS,HARDWR       ;it's a hardwired terminal
DEVL4    BXLE  1,2,DEVL1          ;loop
         DROP  5                  ;release base regs
         DROP  1
*
* Scan the GRAB3270 list for %FLIPped 3270's.
* (Their entries in the dev list point only to the active session).
*
         L     1,=V(GRAB3270)     ;point at list
         LA    1,4(,1)            ;skip mystery word
         USING FLIP,1             ;pointing with R1
FLIP1    L     2,FLPDEV           ;get device name
         LTR   2,2                ;end of list?
         BZ    FLIP5              ;yes, see you
         LH    0,FLPOWN           ;get owning task #
         LR    5,0                ;copy
         N     5,=F'1023'         ;compute offset in hash table
         SLL   5,4
         AR    5,11               ;add base
         LM    6,7,=A(HASHL,HASHE) ;BXLE limits
         XR    4,4                ;load 0
         USING HASHDS,5           ;R5 points at records
FLIP2    C     4,CCID             ;end of bucket?
         BZ    FLIP4              ;yup, forget it
         CH    0,TASKNO           ;is this our task?
         BE    FLIP3              ;yes, goody
         BXLE  5,6,FLIP2          ;check next one
         LR    5,11               ;wrap around
         B     FLIP2              ;keep looking
FLIP3    ST    2,DEVICE           ;copy device name
         OI    FLAGS,HARDWR+FLIPPD ;it's hardwired & %FLIPped
FLIP4    LA    1,FLPLEN(,1)       ;advance
         B     FLIP1              ;loop
FLIP5    EQU   *
         DROP  5                  ;release base regs
         DROP  1
*
* Look up all network (MM) terminals.  We don't know where these
* are located (even the network doesn't know, because the lines
* are handled outboard by the IBX), but at least we can tell them
* what we know.
*
         JSYS  LOADINFO,LILIST    ;go look up MMDVLSTL
         L     1,LREG+8           ;fetch from returned region
         LM    1,3,0(1)           ;get ptrs
         XR    8,8                ;for reference
         USING MMDSECT,1          ;R1 points at records
MMDV1    C     8,MMTYPE           ;is this entry used?
         BZ    MMDV4              ;no, skip it
         TM    MMFLAG+1,1         ;is this their console?
         BNZ   MMDV4              ;no, don't bother
         LH    0,MMOWNR           ;get owning task #
         LR    5,0                ;copy
         N     5,=F'1023'         ;compute offset in hash table
         SLL   5,4
         AR    5,11               ;add base
         LM    6,7,=A(HASHL,HASHE) ;BXLE limits
         XR    4,4                ;load 0
         USING HASHDS,5           ;R5 points at records
MMDV2    C     4,CCID             ;end of bucket?
         BZ    MMDV4              ;yup, forget it
         CH    0,TASKNO           ;is this our task?
         BE    MMDV3              ;yes, goody
         BXLE  5,6,MMDV2          ;check next one
         LR    5,11               ;wrap around
         B     MMDV2              ;keep looking
MMDV3    MVC   DEVICE,MMNAME      ;copy device name
*        MVI   FLAGS,X'00'   ;;;until I fix Courier test
MMDV4    BXLE  1,2,MMDV1
         DROP  5
         DROP  1
*
* Compress the list so we won't have to keep skipping blank spaces
* while we comb the list for each entry in the WHO.NAMES file.
*
COMP     LTR   9,10               ;copy
         BZ    EXITA              ;no users in list (!)
         XR    0,0                ;put 0 in a reg
         LR    1,11               ;point at list
         LR    2,11               ;source and dest
COMP1    C     0,0(,1)            ;is this entry taken?
         BNZ   COMP2              ;yes
         LA    1,HASHL(,1)        ;advance
         B     COMP1              ;loop
COMP2    MVC   0(16,2),0(1)       ;copy 16 bytes
         LA    1,HASHL(,1)        ;advance
         LA    2,HASHL(,2)
         BCT   9,COMP1            ;loop
*
* Update the Big Brother log files.
*
* R2 = offset of field to get line # from
* R3 = offset of field to use as ID field
*
         TM    SWITCH,BB          ;PAR=BB?
         BZ    NOBB               ;no
         LA    1,IDFILE           ;update CCID file first
         LA    2,4                ;point at nameID field
         XR    3,3                ;point at CCID field
         LA    6,2                ;outer loop counter
UDBB1    JSYS  GETFD              ;get FDUB ptr
         ST    0,BBFD             ;save it
         LR    9,10               ;copy count
         LR    8,11               ;point at list
         USING HASHDS,8           ;hash table ptr
UDBB2    L     0,0(2,8)           ;get line #
         ST    0,NMCCID           ;save it
         L     0,0(3,8)           ;get nameID or CCID
         ST    0,CURID            ;save it
         MVC   CURDEV(4),DEVICE   ;copy device name
         JSYS  READ,RDBB          ;read the line
         L     4,=A(FBUF)         ;init offset (in case nonexistent)
         LA    5,BBRECL           ;and length (  "  "       ")
         USING BBREC,4            ;whatever the base is
         LTR   15,15              ;did it exist?
         BNZ   UDBB5              ;no, create it
         LH    5,BBLEN            ;get length
         L     0,CURID            ;get ID again
UDBB3    C     0,RECID            ;does the ID match?
         BE    UDBB6              ;yes, perhaps replace it
         LA    4,BBRECL(,4)       ;advance
         SH    5,=Y(BBRECL)       ;bite off a chunk
         BNZ   UDBB3              ;loop if more
         LH    5,BBLEN            ;get length
         CH    5,=Y(L'FBUF)       ;record full?
         BE    UDBB8              ;forget it if so
         LA    5,BBRECL(,5)       ;update length
UDBB5    STH   5,BBLEN            ;save
         B     UDBB7              ;write updated record
UDBB6    CLC   CURDEV,=F'0'       ;do we know the device?
         BNZ   UDBB7              ;yes, skip
         CLC   RECTIM,CURTIM      ;from the same pass?
         BE    UDBB8              ;don't zap good info with %FLIPs
UDBB7    MVC   0(BBRECL,4),CURID  ;replace record
         JSYS  WRITE,WRBB         ;write updated line
         DROP  4                  ;record ptr
UDBB8    LA    8,HASHL(,8)        ;advance
         BCT   9,UDBB2            ;loop
         JSYS  FREEFD,BBFD        ;release the file
         XR    2,2                ;swap offsets
         LA    3,4
         LA    1,NMFILE           ;pt at nameID filename
         BCT   6,UDBB1            ;loop
         DROP  8
NOBB     LA    9,3                ;try to open 3 times
*
* Open the terminal locations data base if we'll need it.
*
         TM    SWITCH,LOC         ;do we care?
         BZ    OPEN1              ;no
         JSYS  GETFD,TTYLOC       ;do it
         ST    0,TTYFDP           ;save FDUB ptr
*
* Open the WHO.NAMES file.
*
OPEN1    LA    0,1                ;unit #1
         JSYS  GDINFO3            ;implicitly open the file
         LTR   15,15              ;anything on that unit?
         BNZ   OPEN2              ;no, try again
         CLC   4(4,1),=C'NONE'    ;error?
         BNE   OPEN5              ;no, hoopy
OPEN2    BCTR  9,0                ;try # -1
         LTR   9,9                ;time to give up?
         BZ    OPEN4              ;yes
         CH    9,=H'2'            ;was that 1st try?
         BE    OPEN3              ;yes
         MVC   SETLIST+4(4),=A(MYNAMES) ;use my names file
OPEN3    JSYS  SETLIO,SETLIST     ;reassign unit 1
         B     OPEN1              ;try again
OPEN4    JSYS  SERCOM,ERRARG      ;print msg
         B     EXITA              ;bag out
OPEN5    SRL   6,2                ;= # of users in list
* R0-1   scratch
* R2     nameID
* R3     pointer into hash table
* R4     loop counter
* R7     output line pointer
LOOP2    JSYS  READ,RLIST         ;read a line
         LTR   15,15              ;eof?
         BNZ   BUYIT              ;yes, buy it
         LH    2,LEN              ;get length
         LA    2,1(,2)            ;+1 for carr ctrl
         STH   2,LEN              ;replace
         STH   2,SPLEN            ;in case no LOC to fix SPLEN
         L     2,NAMEID#          ;get nameID
         LR    3,11               ;pt at table
         LR    4,10               ;get count
         USING HASHDS,3           ;R3 points at records
LOOP3    C     2,NAMEID           ;are we there yet?
         BE    PUSER              ;skip if so
LP3A     LA    3,HASHL(,3)        ;advance to next
         BCT   4,LOOP3            ;search table
         B     LOOP2              ;get next
PUSER    MVC   NAMEID#(4),CCID    ;copy loserID
         TM    SWITCH,LOC         ;are we showing locations?
         BZ    PUSER1             ;skip if not
         CLC   DEVICE(4),=F'0'    ;did we find them?
         BZ    PUSER1             ;no, don't bother
         LH    7,LEN              ;get actual length
         LA    1,LCOL             ;col to shoot for
         SR    1,7                ;find # to go
         BL    PLOC1              ;already there or beyond
         LA    0,OLINE(7)         ;point at where we're starting from
         BASR  8,0                ;some addressable place
         L     9,=XL4'40000000'   ;src length = 0, pad=C' '
         MVCL  0,8                ;pad out the line
         LA    7,LCOL             ;normalize
PLOC1    LA    7,OLINE(7)         ;index
         MVI   0(7),C' '          ;add a blank
         LA    7,1(,7)            ;skip it
         LA    0,C' '             ;assume not %FLIPped
         TM    FLAGS,FLIPPD       ;is it?
         BZ    PLOC2              ;no
          LA   0,C'*'             ;yes
PLOC2    STC   0,0(,7)            ;save
         LA    7,1(,7)            ;bump ptr
         MVC   0(4,7),DEVICE      ;copy device name
         LA    7,4(,7)            ;skip it
         TM    FLAGS,HARDWR       ;could we know where it is?
         BZ    PLOC3              ;no
         MVC   TTYLIN(4),DEVICE   ;copy line #
         JSYS  READ,TTRLST        ;try to get location
         LTR   15,15              ;did we know it?
         BNZ   PLOC6              ;no
         MVI   0(7),C' '          ;add a blank
         LA    7,1(,7)            ;bump ptr
         LH    1,TTYLEN           ;get length
         SH    1,=Y(TTLDR+1)      ;chop leader, correct for MVC
         EX    1,CMVC1            ;copy
         LA    7,1(1,7)           ;advance
         B     PLOC4              ;continue
PLOC3    CLI   DEVICE,C'N'        ;NIM?
         BNE   PLOC4              ;no
         MVC   0(4,7),=C' NIM'    ;yes
         B     PLOC5              ;skip
PLOC4    CLI   DEVICE,C'H'        ;HIM?
         BNE   PLOC6              ;no
         MVC   0(4,7),=C' HIM'    ;yes
PLOC5    LA    7,4(7)             ;skip
PLOC6    S     7,=A(OLINE)        ;find new length
         STH   7,SPLEN            ;update
PUSER1   JSYS  SPRINT,SPLIST      ;print
         TM    SWITCH,LS          ;are we showing $LS's?
         BZ    LP3A               ;loop if not
* now check their task for locked files
* idea and code modified from that of Michael (The Demon) Beyer
         LH    9,TASKNO           ;get task #
         ST    9,CTASK            ;save it
         JSYS  LSTASK,LSLIST      ;get lock status
         LTR   15,15              ;how'd it go?
         BNZ   BADLS              ;not so hot
* scan LSINFO for files
BADLS1   L     7,ICOUNT           ;get # of records
         LTR   7,7                ;anything?
         BZ    LP3A               ;forget it if not
* make <SF>-form task # for giving readable temp files
* (task # in R9)
         LA    1,3                ;do 3 chars the easy way
LOOPD    XR    8,8                ;sign extend
         D     8,=F'10'           ;/10
         LA    8,C'0'(,8)         ;cvt to EBC DICK
         STC   8,SFTASK(1)        ;put in buf (-1 +1)
         BCT   1,LOOPD            ;loop
         IC    8,HIDIG(9)         ;high digit is screwy
         STC   8,SFTASK           ;(A000 comes after 9999)
         MVC   PFNAME(4),NAMEID#  ;make "CCID:"
         LA    8,LSINFO           ;pt at list
LSLP1    L     9,0(8)             ;get length
         LA    1,8(,8)            ;pt at filename
         AR    8,9                ;skip this record
         L     9,0(1)             ;get length of filename
         LA    1,4(,1)            ;skip length
         C     9,=F'9'            ;long enough for scratch file?
         BL    LSSK1              ;no
         CLC   0(9,1),SFNAME      ;is it a scratch file?
         BNE   LSSK1              ;no
         LA    1,8(,1)            ;yes, skip 8
         S     9,=F'8'            ;fix length
         MVI   0(1),C'-'          ;scratch file
         B     LSSK2              ;skip
LSSK1    C     9,=F'5'            ;long enough for their own file?
         BL    LSSK2              ;no
         CLC   0(5,1),PFNAME      ;is it in their account?
         BNE   LSSK2              ;no
         LA    1,5(,1)            ;yes, skip 5
         S     9,=F'5'            ;fix length
LSSK2    EX    9,CMVC2            ;copy filename
         LA    9,3(,9)            ;bump length
         STH   9,LSPLEN           ;save
         JSYS  SPRINT,LSSPL       ;dump the filename
         BCT   7,LSLP1            ;loop
         B     LP3A               ;keep looking
*
BADLS    C     15,=F'8'           ;buf overrun?
         BNZ   LP3A               ;no, forget it
         B     BADLS1             ;yeah, that's recoverable
         DROP  3                  ;no longer pointing
*
BUYIT    JSYS  CLOSEFIL,UNIT      ;close unit 1
EXITA    EXIT  ,                  ;die
*
         LTORG                    ;dump constant pool
*
TIMLST   DC    A(TIMKEY,ZERO,CURTIM) ;TIME arg list
TIMKEY   DC    F'14'              ;minutes since 03/01/00 00:00
IDFILE   DC    C'&BBID:BB.USERS ' ;userID file
NMFILE   DC    C'&BBID:BB.NAMES ' ;nameID file
RDBB     DC    A(FBUF,BBLEN,RMODS,NMCCID,BBFD)
WRBB     DC    A(FBUF,BBLEN,WMODS,NMCCID,BBFD)
NMCCID   DS    F                  ;use nameID or CCID as line #
RMODS    DC    XL4'08000002'      ;@MAXLEN @I
WMODS    DC    XL4'00000002'      ;@I
BBLEN    DS    H                  ;length read
         DC    Y(L'FBUF)          ;length of buf
         DS    H                  ;useless
CMVC1    MVC   0(0,7),TTLOCN      ;copy TTY loc string
CMVC2    MVC   LSLINE+3(0),0(1)   ;copy filename
HIDIG    DC    C'0123456789ABCDEFGHIJKLMNOPQRSTUVW' ;<SF> high digit
GUINF    DC    A(GUITEM,GULOC)    ;GUINFO('PARSTR  ',GULOC)
GUITEM   DC    A(PARSTR)
GULOC    DC    A(L'PARBUF+8)      ;length of whole region
GULEN    DS    F                  ;actual length goes here
PARBUF   DS    CL64               ;PAR= string goes here
SETLIST  DC    A(UNIT,FNAME)      ;SETLIO arg list
UNIT     DC    F'1'               ;unit #1
MYNAMES  DC    C'ACM0:'           ;acct if they don't have a WHO.NAMES
FNAME    DC    C'WHO.NAMES '      ;filename
TTYLOC   DC    C'&TLID:TERMINALS ' ;Dieter's Courier location database
ERRARG   DC    A(ERRMSG,LERRM,ZERO,DUMMY) ;reg, len, mod, lin
ERRMSG   DC    C' ?WHO-F-Unable to find names file' ;msg
LERRM    DC    Y(L'ERRMSG)        ;length
ZERO     DC    F'0'
RLIST    DC    A(NAMEID#,LEN,@MAXLEN,DUMMY,UNIT)
@MAXLEN  DC    XL4'08000000'      ;gag if too long
DUMMY    DS    F                  ;line # for READ
LEN      DS    H                  ;length read
         DC    H'132'             ;length of buffer
         DS    H                  ;useless
         DS    C                  ;for alignment
OLINE    DC    C' '               ;carriage control
NAMEID#  DS    4C                 ;nameID
NAME     DS    128C               ;name
SPLIST   DC    A(OLINE,SPLEN,ZERO,ZERO)
SPLEN    DS    H                  ;length
LSLIST   DC    A(CTASK,FILTER,LSLEN,ICOUNT,NEEDED,LSINFO)
FILTER   DC    F'255'             ;we see only happy files
LSLEN    DC    A(L'LSINFO)        ;length of region
LSSPL    DC    A(LSLINE,LSPLEN,ZERO,DUMMY) ;$LS SPRINT list
TTRLST   DC    A(TTMODL,TTYLEN,TTYMOD,TTYLIN,TTYFDP)
TTYMOD   DC    XL4'08000002'      ;@MAXLEN @I
LSPLEN   DS    H                  ;length of $LS line
TTYLEN   DS    H                  ;length read
         DC    Y(L'TTLOCN+TTLDR)  ;length of buf
         DS    H                  ;stupid
TTYLIN   DS    F                  ;TTY dev name
TTYFDP   DS    F                  ;term loc FDUB ptr
*
CURID    DS    F                  ;current nameID or CCID
CURDEV   DS    F                  ;current device name
CURTIM   DS    F                  ;curr time (TIME(14,0,CURTIM))
*
BBFD     DS    F                  ;FDUB ptr for BB data file
*
LSLINE   DC    C' '               ;carriage control
         DC    C'  '              ;space over
         DS    30C                ;buffer
*
TTMODL   DS    CL8                ;model
TTDATE   DS    CL8                ;last-seen date
         AIF   (NOT &NEWTERM).NOTSK
TTTASK   DS    CL2                ;last task #
.NOTSK   ANOP
TTFLAG   DS    C                  ;beats me
TTLOCN   DS    CL40               ;location
*
SWITCH   DC    X'00'              ;switches from PAR= string
LOC      EQU   X'01'              ;PAR=LOC (print location)
LS       EQU   X'02'              ;PAR=LS (print $LOCKSTATUS)
BB       EQU   X'04'              ;PAR=BB (do BB snapshot)
*
PFNAME   DS    CL4                ;permanent file name
         DC    C':'               ;ends in colon
*
SFNAME   DC    C'<SF>:'           ;begn of scratch file name
SFTASK   DS    4C                 ;buf for <SF> task #
*
LILIST   DC    A(LTYP,LNAM,LBOUT,LREG) ;LOADINFO parm list
LTYP     DC    F'257'             ;symbol type = resident system
LNAM     DC    CL8'MMDVLSTL'      ;name of symbol
LBOUT    DS    F
LREG     DS    20F                ;output region
*
CTASK    DS    F                  ;current task
ICOUNT   DS    F                  ;# records returned
NEEDED   DS    F                  ;# overflow bytes
*
REGS     DS    18F                ;R13 save area
*
LSINFO   DS    CL400              ;stuff returned by LSTASK
*
HASHT    DS    4092F              ;space for 1023 entries
HASHE    DS    4F                 ;1024th entry
*
FBUF     DS    CL1200             ;BB file buf
*
* Record format for BB data files.
* The line number is the userID, and the line consists
* of one or more records of the following form
* (the number of records can be obtained from the physical
* length of the line).
*
BBREC    DSECT
RECID    DS    F         ;nameID or userID (line # is other)
RECDEV   DS    F         ;device last seen on
RECTIM   DS    F         ;time last seen (from "CALL TIME(14,0,I)")
BBRECL   EQU   12        ;length of a record
*
* Entry format of our own hash table.
* Offset is taken from low 10 bits of task number.
*
HASHDS   DSECT
CCID     DS    F         ;user ID (F'0' if unused)
NAMEID   DS    F         ;name ID
DEVICE   DS    F         ;*MSOURCE*/*MSINK* device name
TASKNO   DS    H         ;task #
FLAGS    DS    X         ;random flags
HARDWR   EQU   X'01'     ;1 => hardwired terminal
FLIPPD   EQU   X'02'     ;1 => device is %FLIPped
         DS    X
HASHL    EQU   16        ;length of a record
*
* The task table is always large enough to hold the maximum
* allowable number of jobs; unused entries are left blank
* (CCID=F'0' or F'-1').
* NBRJBTBL DC Y(size)       gives the size of the job table;
* this number is 640 at RPI, last time I checked - JMBW 5/24/87.
*
TASKTAB  DSECT
TSLOT    DS    1X        ;slot # (00 to FF, then FF till end)
TFLAG    DS    1X        ;seems to be flag bits (FF => end, *usu.*)
TTASK    DS    H         ;task number
TJOBNM   DS    CL8       ;job name
         DS    60X
TUSER    DS    CL4       ;user ID (+X'48')
TPROJ    DS    CL4       ;project number (+X'4C')
         DS    16X
TNAME    DS    CL4       ;*UD name ID (+X'60')
         DS    32X
TSTAT    DS    CL12      ;job status string (sometimes) (+X'84')
         DS    192X
TENTL    DS    0C        ;total length =X'150'
*
* Device list entry format:
*
DEVLST   DSECT
DEVTYP   DS    4C      ;device type ('3270', etc.)
DEVNAM   DS    4C      ;device name ('I008', etc.)
         DS    2C      ; ???
DEVOWN   DS    H       ;task # of owner
         DS    2C        ; ???
DVTIDX   DS    X         ;device type index (even => term)
         DS    5C        ; ???
BLKDRG   DS    A       ;Black Dragon says this is a ptr?
         DS    A       ; ???
DEVCON   DS    A       ;ptr to CONSDEVS record
         DS    4A      ; ???
*
* %FLIPped 3270 list entry format:
*
FLIP     DSECT
FLPDEV   DS    F       ;device name (F'0' marks end)
         DS    H       ;beats me, sometimes 0
FLPOWN   DS    H       ;owner's task #
FLPLEN   EQU   8       ;entry length
*
* MM device list entry format:
*
MMDSECT  DSECT
MMTYPE   DS    CL4     ;connection type ('VTP ', 'X.29', etc.)
MMNAME   DS    CL4     ;port name ('N001' etc.)
MMFLAG   DS    Y       ;flags - bit 0 seems to indicate direction
MMOWNR   DS    Y       ;owner's task #
         DS    A       ;seems to be 0
MMTTAB   DS    A       ;addr of owner's task table entry
         DS    7A      ;seems to be 0
*
         END   WHO

