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 -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' ; 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':' ;begn of scratch file name SFTASK DS 4C ;buf for 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